Merge branch 'dev' into 600-dev-wip-graphql-error-format

.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.2
 
 variables:
   STACK_ROOT: "${CI_PROJECT_DIR}/.stack-root"
@@ -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

CHANGELOG.md

+## 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)
+* [BACK][FIX][[Istex import] Changes in the parser: documents sources are wrong (JSON from ZIP file) (#293)](https://gitlab.iscpif.fr/gargantext/haskell-gargantext/issues/293)
+
 ## Version 0.0.6.9.9.9.4.4
 
 * [FRONT][FIX][trim / deblank missing in invitations modal box (#618)](https://gitlab.iscpif.fr/gargantext/purescript-gargantext/issues/618)

README.md

@@ -53,7 +53,7 @@ sh <(curl -L https://nixos.org/nix/install) --daemon
 Verify the installation is complete with
 ```shell
 nix-env --version
-nix-env (Nix) 2.16.0
+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:
@@ -74,20 +74,6 @@ cabal update
 cabal install
 ```
 
-
-Once you have a valid version of `cabal`, building requires generating a valid `cabal.project`. This can be done by installing `stack2cabal`:
-
-```shell
-cabal v2-install stack2cabal-1.0.14
-```
-
-And finally:
-
-```shell
-stack2cabal --no-run-hpack -p '2023-06-25'
-cabal v2-build
-```
-
 #### With Stack
 
 Install [Stack (or Haskell Tool Stack)](https://docs.haskellstack.org/en/stable/):
@@ -109,9 +95,24 @@ stack build --fast
 ```
 
 
-
 #### Keeping the cabal.project updated with stack.yaml
 
+(Section for Developers using cabal only)
+
+Once you have a valid version of `cabal`, building requires generating a valid `cabal.project`. This can be done by installing `stack2cabal`:
+
+```shell
+cabal v2-install --index-state="2023-12-10T10:34:46Z" --constraint 'Cabal==3.6.3.0' stack2cabal-1.0.14 --overwrite-policy=always
+```
+
+And finally:
+
+```shell
+stack2cabal --no-run-hpack -p '2023-06-25'
+cabal v2-build
+```
+
+
 Simply run:
 
 ```shell

bin/update-cabal-project

@@ -11,18 +11,18 @@ STORE_DIR="${1:-$DEFAULT_STORE}"
 # `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"
+expected_cabal_project_hash="1e4d40d48546606fba0ce0eaae9f2799c57d8ce97c4425940f3a535c4f628a8a"
+expected_cabal_project_freeze_hash="bd90562207ea42857402eced5836b7a23024cc16034bf150968dbf373d2e243c"
 
-cabal --store-dir=$STORE_DIR v2-update 'hackage.haskell.org,2023-11-23T20:05:40Z'
+cabal --store-dir=$STORE_DIR v2-update 'hackage.haskell.org,2023-12-10T10:34:46Z'
 
 # 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
+    cabal --store-dir=$STORE_DIR v2-install --index-state="2023-12-10T10:34:46Z" --constraint 'Cabal==3.6.3.0' stack2cabal-1.0.14 --overwrite-policy=always
 fi
-stack2cabal --no-run-hpack -p '2023-11-23 20:05:40'
+stack2cabal --no-run-hpack -p '2023-12-10 10:34:46'
 
 actual_cabal_project_hash=$(sha256sum cabal.project | awk '{printf "%s",$1}')
 actual_cabal_project_freeze_hash=$(sha256sum cabal.project.freeze | awk '{printf "%s",$1}')

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
     tag: 91928b5d7f9342e9865dde0d94862792d2b88779
 
+source-repository-package
+    type: git
+    location: https://github.com/adinapoli/duckling.git
+    tag: 23603a832117e5352d5b0fb9bb1110228324b35a
+
 source-repository-package
     type: git
     location: https://github.com/adinapoli/haskell-opaleye.git
@@ -19,25 +36,25 @@ source-repository-package
 
 source-repository-package
     type: git
-    location: https://github.com/alpmestan/accelerate.git
-    tag: 640b5af87cea94b61c7737d878e6f7f2fca5c015
+    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-arithmetic.git
-    tag: a110807651036ca2228a76507ee35bbf7aedf87a
+    location: https://github.com/adinapoli/text16-compat.git
+    tag: 85533b5d597e6fc5498411b4bcfc76380ec80d71
 
 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/wikiparsec.git
+    tag: b3519a0351ae9515497680571f76200c24dedb53
 
 source-repository-package
     type: git
-    location: https://github.com/alpmestan/ekg-json.git
-    tag: fd7e5d7325939103cd87d0dc592faf644160341c
+    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,17 +106,17 @@ 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: 9b1bd17f3ed38eab83e675bb68278922217a9c73
+    tag: c0a08d62c40a169b7934ceb7cb12c39952160e7a
 
 source-repository-package
     type: git
@@ -109,7 +126,7 @@ source-repository-package
 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,25 +160,23 @@ 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/rspeer/wikiparsec.git
-    tag: 9637a82344bb70f7fa8f02e75db3c081ccd434ce
+    location: https://github.com/MercuryTechnologies/ekg-json.git
+    tag: 232db57d6ce0940fcc902adf30a9ed3f3561f21d
+
+source-repository-package
+    type: git
+    location: https://github.com/robstewart57/rdf4h.git
+    tag: 4fd2edf30c141600ffad6d730cc4c1c08a6dbce4
 
 allow-older: *
 allow-newer: *

devops/docker/Dockerfile

-FROM ubuntu:jammy
+FROM adinapoli/gargantext:v3.1
 
 ## 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 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
 
 ENV TZ=Europe/Rome
-RUN apt-get update && \
-    apt-get install --no-install-recommends -y \
-      apt-transport-https \
-      autoconf \
-      automake \
-      build-essential \
-      ca-certificates \
-      curl \
-      gcc \
-      git \
-      gnupg2 \
-      libffi-dev \
-      libffi7 \
-      libgmp-dev \
-      libgmp10 \
-      libncurses-dev \
-      libncurses5 \
-      libnuma-dev \
-      libtinfo5 \
-      locales \
-      lsb-release \
-      software-properties-common \
-      strace \
-      sudo \
-      wget \
-      vim \
-      xz-utils \
-      zlib1g-dev \
-      openjdk-18-jdk \
-      unzip && \
-    apt-get clean && rm -rf /var/lib/apt/lists/* && \
-    mkdir -m 0755 /nix && groupadd -r nixbld && chown root /nix && \
-    for n in $(seq 1 10); do useradd -c "Nix build user $n" -d /var/empty -g nixbld -G nixbld -M -N -r -s "$(command -v nologin)" "nixbld$n"; done
 
-RUN gpg --batch --keyserver keys.openpgp.org     --recv-keys 7D1E8AFD1D4A16D71FADA2F2CCC85C0E40C06A8C && \
-    gpg --batch --keyserver keyserver.ubuntu.com --recv-keys FE5AB6C91FEA597C3B31180B73EDE9E8CFBAEF01
 SHELL ["/bin/bash", "-o", "pipefail", "-c"]
 
-RUN cd /root/devops/coreNLP; ./build.sh
-
-RUN set -o pipefail && \
-    bash <(curl -L https://releases.nixos.org/nix/nix-2.15.0/install) --no-daemon && \
-    locale-gen en_US.UTF-8 && chown root -R /nix
-
 ENV LANG='en_US.UTF-8' LANGUAGE='en_US:en' LC_ALL='en_US.UTF-8'
 ENV USER=root
 ENV SHELL /bin/bash
-RUN . "$HOME/.nix-profile/etc/profile.d/nix.sh" && \
-    mkdir -p "/builds/gargantext/" && chmod 777 -R "/builds/gargantext" && \
-    echo "source $HOME/.nix-profile/etc/profile.d/nix.sh" >> "$HOME/.bashrc" && \
-    echo `which nix-env`
-
 ENV PATH=/root/.nix-profile/bin:$PATH
-
-RUN . $HOME/.bashrc && nix-env --version
-
 ENV PATH=/root/.local/bin:$PATH
 
 RUN cd /builds/gargantext && nix-shell

gargantext.cabal

@@ -5,7 +5,7 @@ cabal-version: 2.0
 -- see: https://github.com/sol/hpack
 
 name:           gargantext
-version: 0.0.6.9.9.9.4.4
+version: 0.0.6.9.9.9.4.8
 synopsis:       Search, map, share
 description:    Please see README.md
 category:       Data
@@ -45,6 +45,10 @@ flag test-crypto
   default: False
   manual: True
 
+flag disable-db-obfuscation-executable
+  default: False
+  manual: True
+
 library
   exposed-modules:
       Gargantext
@@ -62,6 +66,7 @@ library
       Gargantext.API.Errors.Types
       Gargantext.API.Errors.Types.Backend
       Gargantext.API.HashedResponse
+      Gargantext.API.Middleware
       Gargantext.API.Ngrams
       Gargantext.API.Ngrams.List
       Gargantext.API.Ngrams.List.Types
@@ -164,6 +169,7 @@ library
       Gargantext.Utils.Jobs.Settings
       Gargantext.Utils.Jobs.State
       Gargantext.Utils.SpacyNLP
+      Gargantext.Utils.SpacyNLP.Types
       Gargantext.Utils.Tuple
       Gargantext.Utils.Zip
   other-modules:
@@ -393,7 +399,7 @@ library
       RankNTypes
       RecordWildCards
       StrictData
-  ghc-options: -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates -Wmissing-signatures -Wunused-binds -Wunused-imports -Werror -freduction-depth=300 -fplugin=Clippy -fprint-potential-instances
+  ghc-options: -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates -Wmissing-signatures -Wunused-binds -Wunused-imports -Werror -freduction-depth=300 -fprint-potential-instances
   if flag(test-crypto)
     cpp-options: -DTEST_CRYPTO
   build-depends:
@@ -409,6 +415,7 @@ library
     , accelerate-utility ^>= 1.0.0.1
     , aeson ^>= 1.5.6.0
     , aeson-pretty ^>= 0.8.9
+    , ansi-terminal
     , array ^>= 0.5.4.0
     , async ^>= 2.2.4
     , attoparsec ^>= 0.13.2.5
@@ -457,7 +464,6 @@ library
     , fullstop ^>= 0.1.4
     , gargantext-graph >=0.1.0.0
     , gargantext-prelude
-    , ghc-clippy-plugin ^>= 0.0.0.1
     , graphviz ^>= 2999.20.1.0
     , hashable ^>= 1.3.0.0
     , haskell-igraph ^>= 0.10.4
@@ -472,24 +478,33 @@ library
     , http-media ^>= 0.8.0.0
     , http-types ^>= 0.12.3
     , hxt ^>= 9.3.1.22
-    , ihaskell ^>= 0.10.2.2
+    , ihaskell >= 0.11.0.0
+    -- necessary for ihaskell to build
+    , ipython-kernel >= 0.11.0.0
     , ini ^>= 0.4.1
     , insert-ordered-containers ^>= 0.2.5.1
     , iso639
     , jose ^>= 0.8.4
     , json-stream ^>= 0.4.2.4
     , lens ^>= 4.19.2
+    , lens-aeson < 1.3
     , lifted-base ^>= 0.2.3.12
     , listsafe ^>= 0.1.0.1
+    , llvm-hs >= 12.0.0
     , located-base ^>= 0.1.1.1
     , logging-effect ^>= 1.3.12
     , matrix ^>= 0.3.6.1
     , monad-control ^>= 1.0.3.1
     , monad-logger ^>= 0.3.36
-    , morpheus-graphql ^>= 0.17.0
-    , morpheus-graphql-app ^>= 0.17.0
-    , morpheus-graphql-core ^>= 0.17.0
-    , morpheus-graphql-subscriptions ^>= 0.17.0
+    , morpheus-graphql >= 0.17.0 && < 0.25
+    , morpheus-graphql-app >= 0.17.0 && < 0.25
+    , morpheus-graphql-client >= 0.17.0 && < 0.25
+    , morpheus-graphql-code-gen >= 0.17.0 && < 0.25
+    , morpheus-graphql-code-gen-utils >= 0.17.0 && < 0.25
+    , morpheus-graphql-core >= 0.17.0 && < 0.25
+    , morpheus-graphql-server >= 0.17.0 && < 0.25
+    , morpheus-graphql-subscriptions >= 0.17.0 && < 0.25
+    , morpheus-graphql-tests >= 0.17.0 && < 0.25
     , mtl ^>= 2.2.2
     , natural-transformation ^>= 0.4
     , network-uri ^>= 2.6.4.1
@@ -523,26 +538,26 @@ library
     , scientific ^>= 0.3.7.0
     , semigroups ^>= 0.19.2
     , serialise ^>= 0.2.4.0
-    , servant ^>= 0.18.3
+    , servant >= 0.18.3 && < 0.20
     , servant-auth ^>= 0.4.0.0
     , servant-auth-client ^>= 0.4.1.0
     , servant-auth-server ^>=0.4.6.0
     , servant-auth-swagger ^>= 0.2.10.1
     , servant-blaze ^>= 0.9.1
     , servant-cassava ^>= 0.10.1
-    , servant-client ^>= 0.18.3
-    , servant-client-core ^>= 0.18.3
+    , servant-client >= 0.18.3 && < 0.20
+    , servant-client-core >= 0.18.3 && < 0.20
     , servant-ekg ^>= 0.3.1
     , servant-flatten ^>= 0.2
     , servant-job >= 0.2.0.0
-    , servant-mock ^>= 0.8.7
     , servant-multipart ^>= 0.12.1
-    , servant-server ^>= 0.18.3
+    , servant-server >= 0.18.3 && < 0.20
     , servant-swagger ^>= 1.1.10
     , servant-swagger-ui ^>= 0.3.5.3.5.0
     , servant-xml-conduit >= 0.1.0.4
     , simple-reflect ^>= 0.3.3
     , singletons ^>= 2.7
+    , singletons-th >= 3.1
     , split ^>= 0.2.3.4
     , stemmer ^>= 0.5.2
     , stm ^>= 2.5.0.1
@@ -566,7 +581,7 @@ library
     , uuid ^>= 1.3.15
     , validity ^>= 0.11.0.1
     , vector ^>= 0.12.3.0
-    , wai ^>= 3.2.3
+    , wai >= 3.2.4
     , wai-app-static ^>= 3.1.7.3
     , wai-cors ^>= 0.2.7
     , wai-extra ^>= 3.1.8
@@ -710,15 +725,18 @@ executable gargantext-db-obfuscation
       RecordWildCards
       StrictData
   ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N -O2 -Wmissing-signatures
-  build-depends:
-      base
-    , extra
-    , gargantext
-    , gargantext-prelude
-    , optparse-simple
-    , postgresql-simple ^>= 0.6.4
-    , text
-  default-language: Haskell2010
+  if flag(disable-db-obfuscation-executable)
+    buildable: False
+  else
+    build-depends:
+        base
+      , extra
+      , gargantext
+      , gargantext-prelude
+      , optparse-simple
+      , postgresql-simple ^>= 0.6.4
+      , text
+    default-language: Haskell2010
 
 executable gargantext-import
   main-is: Main.hs

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

@@ -45,6 +45,7 @@ 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.EKG
+import Gargantext.API.Middleware (logStdoutDevSanitised)
 import Gargantext.API.Ngrams (saveNodeStoryImmediate)
 import Gargantext.API.Routes
 import Gargantext.API.Server (server)
@@ -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
 
@@ -210,7 +211,10 @@ makeDevMiddleware mode = do
     --pure (warpS, logWare . checkOriginAndHost . corsMiddleware)
     case mode of
       Prod -> pure $ logStdout . corsMiddleware
-      _    -> pure $ logStdoutDev . corsMiddleware
+      _    -> do
+        loggerMiddleware <- logStdoutDevSanitised
+        pure $ loggerMiddleware . corsMiddleware
+
 
 ---------------------------------------------------------------------
 -- | API Global

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

@@ -52,16 +52,11 @@ 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
@@ -72,7 +67,6 @@ data AuthenticationError
 type AuthContext = '[JWTSettings, CookieSettings] -- , BasicAuthCfg
 
 -- | Instances
-$(deriveJSON (unPrefix "_authReq_") ''AuthRequest)
 instance ToSchema AuthRequest where
   declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_authReq_")
 
@@ -82,7 +76,6 @@ instance Arbitrary AuthRequest where
                        , p <- arbitraryPassword
                        ]
 
-$(deriveJSON (unPrefix "_authRes_") ''AuthResponse)
 instance ToSchema AuthResponse where
   declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_authRes_")
 instance Arbitrary AuthResponse where
@@ -102,20 +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_")
 
+--
+-- 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/Settings.hs

@@ -24,7 +24,8 @@ 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.Types
@@ -217,7 +218,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/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/Errors/Types.hs

@@ -666,8 +666,8 @@ genFrontendErr be = do
     EC_404__tree_empty_root
       -> pure $ mkFrontendErr' txt $ FE_tree_empty_root
     EC_500__tree_too_many_roots
-      -> do nodes <- arbitrary
-            pure $ mkFrontendErr' txt $ FE_tree_too_many_roots nodes
+      -> do nodes <- getNonEmpty <$> arbitrary
+            pure $ mkFrontendErr' txt $ FE_tree_too_many_roots (NE.fromList nodes)
 
     -- job errors
     EC_500__job_invalid_id_type

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)
@@ -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/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
+resolveSchools (SchoolsArgs ()) = pure $ schools

src/Gargantext/API/GraphQL/NLP.hs

 {-# LANGUAGE DeriveAnyClass #-}
-{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE DerivingStrategies #-}
 
 module Gargantext.API.GraphQL.NLP
   ( Lang(..)
@@ -18,9 +18,10 @@ 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
 
@@ -33,7 +34,7 @@ data NLPServer = NLPServer
 
 resolveLanguages
   :: HasNLPServer env => LanguagesArgs -> GqlM e env LanguagesMap
-resolveLanguages LanguagesArgs { } = do
+resolveLanguages ( LanguagesArgs () ) = do
   -- pure $ allLangs
   lift $ do
     ns <- view nlpServer

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/Utils.hs

@@ -8,6 +8,8 @@ Stability   : experimental
 Portability : POSIX
 -}
 
+{-# OPTIONS_GHC -Wno-deprecations #-} -- FIXME(adn) GraphQL will need updating.
+
 module Gargantext.API.GraphQL.Utils where
 
 import Control.Lens ((^.))

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.Char8 qualified as C8
+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))
+          <> " "
+          <> "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

src/Gargantext/API/Ngrams.hs

@@ -120,7 +120,7 @@ import Gargantext.Database.Query.Table.Node (getNode)
 import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
 import Gargantext.Database.Query.Table.Node.Select
 import Gargantext.Database.Schema.Node (node_id, node_parent_id, node_user_id)
-import Gargantext.Prelude hiding (log, to, toLower, (%))
+import Gargantext.Prelude hiding (log, to, toLower, (%), isInfixOf)
 import Gargantext.Prelude.Clock (hasTime, getTime)
 import Gargantext.Utils.Jobs (serveJobsAPI, MonadJobStatus(..))
 import GHC.Conc (readTVar, writeTVar)

src/Gargantext/API/Ngrams/List/Types.hs

@@ -9,12 +9,9 @@ Portability : POSIX
 
 -}
 
-
-module Gargantext.API.Ngrams.List.Types where
-
---{-# LANGUAGE TemplateHaskell   #-}
 {-# LANGUAGE TypeOperators     #-}
 
+module Gargantext.API.Ngrams.List.Types where
 
 --import Control.Lens hiding (elements, Indexed)
 import Data.Aeson

src/Gargantext/API/Ngrams/Tools.hs

@@ -9,7 +9,8 @@ Portability : POSIX
 
 -}
 
-{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeFamilies  #-}
+{-# LANGUAGE TypeOperators #-}
 
 module Gargantext.API.Ngrams.Tools
   where

src/Gargantext/API/Ngrams/Types.hs

@@ -84,8 +84,6 @@ instance ToParamSchema TabType
 instance ToJSON        TabType
 instance FromJSON      TabType
 instance ToSchema      TabType
-instance Arbitrary     TabType where
-  arbitrary = elements [minBound .. maxBound]
 instance FromJSONKey TabType where
   fromJSONKey = genericFromJSONKey defaultJSONKeyOptions
 instance ToJSONKey TabType where
@@ -161,14 +159,11 @@ deriveJSON (unPrefix "_nre_") ''NgramsRepoElement
 makeLenses ''NgramsRepoElement
 instance ToSchema NgramsRepoElement where
   declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_nre_")
-instance Serialise NgramsRepoElement
 instance FromField NgramsRepoElement where
   fromField = fromJSONField
 instance ToField NgramsRepoElement where
   toField = toJSONField
 
-instance Serialise (MSet NgramsTerm)
-
 data NgramsElement =
      NgramsElement { _ne_ngrams      :: NgramsTerm
                    , _ne_size        :: Int
@@ -197,9 +192,6 @@ newNgramsElement mayList ngrams =
 
 instance ToSchema NgramsElement where
   declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_ne_")
-instance Arbitrary NgramsElement where
-  arbitrary = elements [newNgramsElement Nothing "sport"]
-
 
 ------------------------------------------------------------------------
 newtype NgramsTable = NgramsTable [NgramsElement]
@@ -257,9 +249,6 @@ mockTable = NgramsTable
   where
     rp n = Just $ RootParent n n
 
-instance Arbitrary NgramsTable where
-  arbitrary = pure mockTable
-
 instance ToSchema NgramsTable
 
 ------------------------------------------------------------------------
@@ -283,10 +272,6 @@ instance ToParamSchema OrderBy
 instance FromJSON  OrderBy
 instance ToJSON    OrderBy
 instance ToSchema  OrderBy
-instance Arbitrary OrderBy
-  where
-    arbitrary = elements [minBound..maxBound]
-
 
 -- | A query on a 'NgramsTable'.
 data NgramsSearchQuery = NgramsSearchQuery
@@ -367,8 +352,6 @@ instance ToSchema a => ToSchema (PatchSet a)
 
 type AddRem = Replace (Maybe ())
 
-instance Serialise AddRem
-
 remPatch, addPatch :: AddRem
 remPatch = replace (Just ()) Nothing
 addPatch = replace Nothing (Just ())
@@ -388,9 +371,6 @@ unPatchMSet (PatchMSet a) = a
 type ConflictResolutionPatchMSet a = a -> ConflictResolutionReplace (Maybe ())
 type instance ConflictResolution (PatchMSet a) = ConflictResolutionPatchMSet a
 
-instance (Serialise a, Ord a) => Serialise (PatchMap a AddRem)
-instance (Serialise a, Ord a) => Serialise (PatchMSet a)
-
 -- TODO this breaks module abstraction
 makePrisms ''PM.PatchMap
 
@@ -419,19 +399,12 @@ instance (Ord a, ToJSON a) => ToJSON (PatchMSet a) where
 instance (Ord a, FromJSON a) => FromJSON (PatchMSet a) where
   parseJSON = fmap (_PatchMSetIso #) . parseJSON
 
-instance (Ord a, Arbitrary a) => Arbitrary (PatchMSet a) where
-  arbitrary = (PatchMSet . PM.fromMap) <$> arbitrary
-
 instance ToSchema a => ToSchema (PatchMSet a) where
   -- TODO
   declareNamedSchema _ = wellNamedSchema "" (Proxy :: Proxy TODO)
 
 type instance Patched (PatchMSet a) = MSet a
 
-instance (Eq a, Arbitrary a) => Arbitrary (Replace a) where
-  arbitrary = uncurry replace <$> arbitrary
-    -- If they happen to be equal then the patch is Keep.
-
 instance ToSchema a => ToSchema (Replace a) where
   declareNamedSchema (_ :: Proxy (Replace a)) = do
     -- TODO Keep constructor is not supported here.
@@ -475,19 +448,11 @@ instance ToSchema NgramsPatch where
                 , ("old",      nreSch)
                 , ("new",      nreSch)
                 ]
-instance Arbitrary NgramsPatch where
-  arbitrary = frequency [ (9, NgramsPatch <$> arbitrary <*> (replace <$> arbitrary <*> arbitrary))
-                        , (1, NgramsReplace <$> arbitrary <*> arbitrary)
-                        ]
-instance Serialise NgramsPatch
 instance FromField NgramsPatch where
   fromField = fromJSONField
 instance ToField NgramsPatch where
   toField = toJSONField
 
-instance Serialise (Replace ListType)
-
-instance Serialise ListType
 
 type NgramsPatchIso =
   MaybePatch NgramsRepoElement (PairPatch (PatchMSet NgramsTerm) (Replace ListType))
@@ -555,9 +520,6 @@ newtype NgramsTablePatch = NgramsTablePatch (PatchMap NgramsTerm NgramsPatch)
 mkNgramsTablePatch :: Map NgramsTerm NgramsPatch -> NgramsTablePatch
 mkNgramsTablePatch = NgramsTablePatch . PM.fromMap
 
-instance Serialise NgramsTablePatch
-instance Serialise (PatchMap NgramsTerm NgramsPatch)
-
 instance FromField NgramsTablePatch
   where
     fromField = fromJSONField
@@ -690,9 +652,6 @@ instance Action NgramsTablePatch (Maybe NgramsTableMap) where
     fmap (execState (reParentNgramsTablePatch p)) .
     act (p ^. _NgramsTablePatch)
 
-instance Arbitrary NgramsTablePatch where
-  arbitrary = NgramsTablePatch <$> PM.fromMap <$> arbitrary
-
 -- Should it be less than an Lens' to preserve PatchMap's abstraction.
 -- ntp_ngrams_patches :: Lens' NgramsTablePatch (Map NgramsTerm NgramsPatch)
 -- ntp_ngrams_patches = _NgramsTablePatch .  undefined
@@ -709,8 +668,6 @@ deriveJSON (unPrefix "_v_") ''Versioned
 makeLenses ''Versioned
 instance (Typeable a, ToSchema a) => ToSchema (Versioned a) where
   declareNamedSchema = wellNamedSchema "_v_"
-instance Arbitrary a => Arbitrary (Versioned a) where
-  arbitrary = Versioned 1 <$> arbitrary -- TODO 1 is constant so far
 ------------------------------------------------------------------------
 type Count = Int
 
@@ -724,8 +681,6 @@ deriveJSON (unPrefix "_vc_") ''VersionedWithCount
 makeLenses ''VersionedWithCount
 instance (Typeable a, ToSchema a) => ToSchema (VersionedWithCount a) where
   declareNamedSchema = wellNamedSchema "_vc_"
-instance Arbitrary a => Arbitrary (VersionedWithCount a) where
-  arbitrary = VersionedWithCount 1 1 <$> arbitrary -- TODO 1 is constant so far
 
 toVersionedWithCount :: Count -> Versioned a -> VersionedWithCount a
 toVersionedWithCount count (Versioned version data_) = VersionedWithCount version count data_
@@ -749,8 +704,6 @@ instance (ToJSON s, ToJSON p) => ToJSON (Repo s p) where
   toJSON     = genericToJSON     $ unPrefix "_r_"
   toEncoding = genericToEncoding $ unPrefix "_r_"
 
-instance (Serialise s, Serialise p) => Serialise (Repo s p)
-
 makeLenses ''Repo
 
 initRepo :: Monoid s => Repo s p
@@ -771,11 +724,6 @@ type RepoCmdM   env err m =
 
 
 -- Instances
-instance Arbitrary NgramsRepoElement where
-  arbitrary = elements $ map ngramsElementToRepo ns
-    where
-      NgramsTable ns = mockTable
-
 instance FromHttpApiData (Map TableNgrams.NgramsType (Versioned NgramsTableMap))
   where
     parseUrlPiece x = maybeToEither x (decode $ cs x)
@@ -814,3 +762,51 @@ instance ToSchema UpdateTableNgramsCharts where
 
 ------------------------------------------------------------------------
 type NgramsList = (Map TableNgrams.NgramsType (Versioned NgramsTableMap))
+
+--
+-- Serialise instances
+--
+
+instance Serialise ListType
+instance Serialise NgramsRepoElement
+instance Serialise NgramsTablePatch
+instance Serialise (PatchMap NgramsTerm NgramsPatch)
+instance Serialise (MSet NgramsTerm)
+instance Serialise AddRem
+instance Serialise NgramsPatch
+instance Serialise (Replace ListType)
+instance (Serialise a, Ord a) => Serialise (PatchMap a AddRem)
+instance (Serialise a, Ord a) => Serialise (PatchMSet a)
+instance (Serialise s, Serialise p) => Serialise (Repo s p)
+
+--
+-- Arbitrary instances
+--
+instance Arbitrary     TabType where
+  arbitrary = elements [minBound .. maxBound]
+instance Arbitrary NgramsElement where
+  arbitrary = elements [newNgramsElement Nothing "sport"]
+instance Arbitrary NgramsTable where
+  arbitrary = pure mockTable
+instance Arbitrary OrderBy
+  where
+    arbitrary = elements [minBound..maxBound]
+instance (Ord a, Arbitrary a) => Arbitrary (PatchMSet a) where
+  arbitrary = (PatchMSet . PM.fromMap) <$> arbitrary
+instance (Eq a, Arbitrary a) => Arbitrary (Replace a) where
+  arbitrary = uncurry replace <$> arbitrary
+    -- If they happen to be equal then the patch is Keep.
+instance Arbitrary NgramsPatch where
+  arbitrary = frequency [ (9, NgramsPatch <$> arbitrary <*> (replace <$> arbitrary <*> arbitrary))
+                        , (1, NgramsReplace <$> arbitrary <*> arbitrary)
+                        ]
+instance Arbitrary NgramsTablePatch where
+  arbitrary = NgramsTablePatch <$> PM.fromMap <$> arbitrary
+instance Arbitrary a => Arbitrary (Versioned a) where
+  arbitrary = Versioned 1 <$> arbitrary -- TODO 1 is constant so far
+instance Arbitrary a => Arbitrary (VersionedWithCount a) where
+  arbitrary = VersionedWithCount 1 1 <$> arbitrary -- TODO 1 is constant so far
+instance Arbitrary NgramsRepoElement where
+  arbitrary = elements $ map ngramsElementToRepo ns
+    where
+      NgramsTable ns = mockTable

src/Gargantext/API/Node.hs

@@ -189,62 +189,6 @@ nodeNodeAPI p uId cId nId = withAccess (Proxy :: Proxy (NodeNodeAPI a)) Proxy uI
     nodeNodeAPI' :: GargServer (NodeNodeAPI a)
     nodeNodeAPI' = getNodeWith nId p
 
-------------------------------------------------------------------------
--- TODO: make the NodeId type indexed by `a`, then we no longer need the proxy.
-nodeAPI :: forall proxy a.
-       ( HyperdataC a, Show a
-       ) => proxy a
-         -> AuthenticatedUser
-         -> NodeId
-         -> ServerT (NodeAPI a) (GargM Env BackendInternalError)
-nodeAPI p authenticatedUser targetNode =
-  withAccess (Proxy :: Proxy (NodeAPI a)) Proxy authenticatedUser (PathNode targetNode) nodeAPI'
-  where
-
-    userRootId = RootId $ authenticatedUser ^. auth_node_id
-
-    nodeAPI' :: ServerT (NodeAPI a) (GargM Env BackendInternalError)
-    nodeAPI' =  withPolicy authenticatedUser (nodeChecks targetNode) (getNodeWith targetNode p)
-           :<|> rename                                targetNode
-           :<|> postNode            authenticatedUser targetNode
-           :<|> postNodeAsyncAPI    authenticatedUser targetNode
-           :<|> FrameCalcUpload.api authenticatedUser targetNode
-           :<|> putNode                               targetNode
-           :<|> Update.api                            targetNode
-           :<|> Action.deleteNode   userRootId        targetNode
-           :<|> getChildren                           targetNode p
-
-           -- TODO gather it
-           :<|> tableApi                              targetNode
-           :<|> apiNgramsTableCorpus                  targetNode
-
-           :<|> catApi                                targetNode
-           :<|> scoreApi                              targetNode
-           :<|> Search.api                            targetNode
-           :<|> Share.api           userRootId        targetNode
-           -- Pairing Tools
-           :<|> pairWith                              targetNode
-           :<|> pairs                                 targetNode
-           :<|> getPair                               targetNode
-
-           -- VIZ
-           :<|> scatterApi                            targetNode
-           :<|> chartApi                              targetNode
-           :<|> pieApi                                targetNode
-           :<|> treeApi                               targetNode
-           :<|> phyloAPI                              targetNode
-           :<|> moveNode           userRootId         targetNode
-           -- :<|> nodeAddAPI id'
-           -- :<|> postUpload id'
-           :<|> Share.unPublish                       targetNode
-
-           :<|> fileApi                               targetNode
-           :<|> fileAsyncApi       authenticatedUser  targetNode
-
-           :<|> DFWN.api           authenticatedUser  targetNode
-           :<|> DocumentUpload.api                    targetNode
-
-
 ------------------------------------------------------------------------
 data RenameNode = RenameNode { r_name :: Text }
   deriving (Generic)
@@ -374,5 +318,59 @@ instance ToSchema  RenameNode
 instance Arbitrary RenameNode where
   arbitrary = elements [RenameNode "test"]
 
+------------------------------------------------------------------------
+-- TODO: make the NodeId type indexed by `a`, then we no longer need the proxy.
+nodeAPI :: forall proxy a.
+       ( HyperdataC a, Show a, MimeUnrender JSON a
+       ) => proxy a
+         -> AuthenticatedUser
+         -> NodeId
+         -> ServerT (NodeAPI a) (GargM Env BackendInternalError)
+nodeAPI p authenticatedUser targetNode =
+  withAccess (Proxy :: Proxy (NodeAPI a)) Proxy authenticatedUser (PathNode targetNode) nodeAPI'
+  where
+
+    userRootId = RootId $ authenticatedUser ^. auth_node_id
+
+    nodeAPI' :: ServerT (NodeAPI a) (GargM Env BackendInternalError)
+    nodeAPI' =  withPolicy authenticatedUser (nodeChecks targetNode) (getNodeWith targetNode p)
+           :<|> rename                                targetNode
+           :<|> postNode            authenticatedUser targetNode
+           :<|> postNodeAsyncAPI    authenticatedUser targetNode
+           :<|> FrameCalcUpload.api authenticatedUser targetNode
+           :<|> putNode                               targetNode
+           :<|> Update.api                            targetNode
+           :<|> Action.deleteNode   userRootId        targetNode
+           :<|> getChildren                           targetNode p
+
+           -- TODO gather it
+           :<|> tableApi                              targetNode
+           :<|> apiNgramsTableCorpus                  targetNode
+
+           :<|> catApi                                targetNode
+           :<|> scoreApi                              targetNode
+           :<|> Search.api                            targetNode
+           :<|> Share.api           userRootId        targetNode
+           -- Pairing Tools
+           :<|> pairWith                              targetNode
+           :<|> pairs                                 targetNode
+           :<|> getPair                               targetNode
+
+           -- VIZ
+           :<|> scatterApi                            targetNode
+           :<|> chartApi                              targetNode
+           :<|> pieApi                                targetNode
+           :<|> treeApi                               targetNode
+           :<|> phyloAPI                              targetNode
+           :<|> moveNode           userRootId         targetNode
+           -- :<|> nodeAddAPI id'
+           -- :<|> postUpload id'
+           :<|> Share.unPublish                       targetNode
+
+           :<|> fileApi                               targetNode
+           :<|> fileAsyncApi       authenticatedUser  targetNode
+
+           :<|> DFWN.api           authenticatedUser  targetNode
+           :<|> DocumentUpload.api                    targetNode
+
 
--------------------------------------------------------------

src/Gargantext/API/Node/Corpus/New.hs

@@ -39,7 +39,7 @@ import Gargantext.API.Node.Corpus.Types
 import Gargantext.API.Node.Corpus.Update (addLanguageToCorpus)
 import Gargantext.API.Node.Types
 import Gargantext.Core (Lang(..), withDefaultLanguage, defaultLanguage)
-import Gargantext.Core.NodeStory (HasNodeStoryImmediateSaver, HasNodeArchiveStoryImmediateSaver, currentVersion)
+import Gargantext.Core.NodeStory (HasNodeStoryImmediateSaver, HasNodeArchiveStoryImmediateSaver, currentVersion, NgramsStatePatch')
 import Gargantext.Core.Text.Corpus.API qualified as API
 import Gargantext.Core.Text.Corpus.Parsers qualified as Parser (FileType(..), parseFormatC)
 import Gargantext.Core.Text.List.Social (FlowSocialListWith(..))
@@ -51,7 +51,7 @@ import Gargantext.Database.Action.Mail (sendMail)
 import Gargantext.Database.Action.Node (mkNodeWithParent)
 import Gargantext.Database.Action.User (getUserId)
 import Gargantext.Database.Admin.Types.Hyperdata
-import Gargantext.Database.Admin.Types.Node (CorpusId, NodeType(..))
+import Gargantext.Database.Admin.Types.Node (CorpusId, NodeType(..), ParentId)
 import Gargantext.Database.GargDB qualified as GargDB
 import Gargantext.Database.Prelude (hasConfig)
 import Gargantext.Database.Query.Table.Node (getNodeWith, getOrMkList)
@@ -252,10 +252,7 @@ addToCorpusWithQuery user cid (WithQuery { _wq_query = q
           corpusId <- flowDataText user txt (Multi l) cid (Just flw) jobHandle
           $(logLocM) DEBUG $ T.pack $ "corpus id " <> show corpusId
 
-          userId <- getUserId user
-          listId <- getOrMkList cid userId
-          v <- currentVersion listId
-          _ <- commitStatePatch listId (Versioned v mempty)
+          _ <- commitCorpus cid user
           
           -- printDebug "sending email" ("xxxxxxxxxxxxxxxxxxxxx" :: Text)
           sendMail user
@@ -275,7 +272,10 @@ type AddWithForm = Summary "Add with FormUrlEncoded to corpus endpoint"
    :> "async"
      :> AsyncJobs JobLog '[FormUrlEncoded] NewWithForm JobLog
 
-addToCorpusWithForm :: (FlowCmdM env err m, MonadJobStatus m)
+addToCorpusWithForm :: ( FlowCmdM env err m
+                       , MonadJobStatus m
+                       , HasNodeStoryImmediateSaver env
+                       , HasNodeArchiveStoryImmediateSaver env )
                     => User
                     -> CorpusId
                     -> NewWithForm
@@ -344,6 +344,8 @@ addToCorpusWithForm user cid nwf jobHandle = do
                           --(map (map toHyperdataDocument) docs)
                           jobHandle
 
+      _ <- commitCorpus cid user
+
       -- printDebug "Extraction finished   : " cid
       -- printDebug "sending email" ("xxxxxxxxxxxxxxxxxxxxx" :: Text)
       -- TODO uncomment this
@@ -422,3 +424,17 @@ addToCorpusWithFile user cid nwf@(NewWithFile _d (withDefaultLanguage -> l) fNam
   sendMail user
 
   markComplete jobHandle
+
+
+
+--- UTILITIES
+
+commitCorpus :: ( FlowCmdM env err m
+                , HasNodeArchiveStoryImmediateSaver env
+                , HasNodeStoryImmediateSaver env )
+             => ParentId -> User -> m (Versioned NgramsStatePatch')
+commitCorpus cid user = do  
+  userId <- getUserId user
+  listId <- getOrMkList cid userId
+  v <- currentVersion listId
+  commitStatePatch listId (Versioned v mempty)

src/Gargantext/API/Node/Document/Export/Types.hs

@@ -94,6 +94,6 @@ type API = Summary "Document Export"
                :<|> "csv"
                :> Get '[PlainText] (Headers '[Servant.Header "Content-Disposition" Text] Text)) -- [Document])
 
-$(deriveJSON (unPrefix "_de_") ''DocumentExport)
-$(deriveJSON (unPrefix "_d_") ''Document)
 $(deriveJSON (unPrefix "_ng_") ''Ngrams)
+$(deriveJSON (unPrefix "_d_") ''Document)
+$(deriveJSON (unPrefix "_de_") ''DocumentExport)

src/Gargantext/API/Node/FrameCalcUpload.hs

@@ -35,6 +35,7 @@ import Gargantext.API.Node.Corpus.New.Types (FileFormat(..), FileType(..))
 import Gargantext.API.Node.Types (NewWithForm(..))
 import Gargantext.API.Prelude
 import Gargantext.Core (Lang)
+import Gargantext.Core.NodeStory (HasNodeArchiveStoryImmediateSaver)
 import Gargantext.Core.Text.List.Social (FlowSocialListWith(..))
 import Gargantext.Core.Types.Individu (User(..))
 import Gargantext.Database.Action.Flow.Types
@@ -70,7 +71,10 @@ api authenticatedUser nId =
 
 
 
-frameCalcUploadAsync :: (HasConfig env, FlowCmdM env err m, MonadJobStatus m)
+frameCalcUploadAsync :: ( HasConfig env
+                        , FlowCmdM env err m
+                        , MonadJobStatus m
+                        , HasNodeArchiveStoryImmediateSaver env )
                      => AuthenticatedUser
                      -- ^ The logged-in user
                      -> NodeId

src/Gargantext/Core.hs

@@ -75,7 +75,7 @@ instance ToSchema Lang where
   declareNamedSchema = genericDeclareNamedSchemaUnrestricted defaultSchemaOptions
 instance FromHttpApiData Lang
   where
-    parseUrlPiece "All" = pure All
+    -- parseUrlPiece "All" = pure All
     parseUrlPiece "DE"  = pure DE
     parseUrlPiece "EL"  = pure EL
     parseUrlPiece "EN"  = pure EN

src/Gargantext/Core/NLP.hs

@@ -64,7 +64,7 @@ nlpServerConfigFromURI _ = Nothing
 nlpServerMap :: NLPConfig -> NLPServerMap
 nlpServerMap (NLPConfig { .. }) =
   Map.fromList $ catMaybes $
-    [ uncurryMaybeSecond (All, nlpServerConfigFromURI _nlp_all) ] ++
+    [ uncurryMaybeSecond (EN, nlpServerConfigFromURI _nlp_default) ] ++
     ((\lang ->
         uncurryMaybeSecond (lang, Map.lookup (show lang) _nlp_languages >>= nlpServerConfigFromURI ))
       <$> allLangs)

src/Gargantext/Core/NodeStory.hs

@@ -701,7 +701,7 @@ clearHistory (NodeStory ns) = NodeStory $ ns & (traverse . a_history) .~ emptyHi
 currentVersion :: (HasNodeStory env err m) => ListId -> m Version
 currentVersion listId = do
   pool <- view connPool
-  nls <- withResource pool $ \c -> liftBase $ getNodeStory c listId
+  nls <- liftBase $ withResource pool $ \c -> liftBase $ getNodeStory c listId
   pure $ nls ^. unNodeStory . at listId . _Just . a_version
 
 
@@ -711,7 +711,7 @@ currentVersion listId = do
 fixNodeStoryVersions :: (HasNodeStory env err m) => m ()
 fixNodeStoryVersions = do
   pool <- view connPool
-  _ <- withResource pool $ \c -> liftBase $ PGS.withTransaction c $ do
+  _ <- liftBase $ withResource pool $ \c -> liftBase $ PGS.withTransaction c $ do
     nIds <- runPGSQuery c [sql| SELECT id FROM nodes WHERE ? |] (PGS.Only True) :: IO [PGS.Only Int64]
     -- printDebug "[fixNodeStoryVersions] nIds" nIds
     mapM_ (\(PGS.Only nId) -> do

src/Gargantext/Core/Text/Corpus/API/Hal.hs

@@ -56,8 +56,8 @@ toDoc' la (HAL.Corpus { .. }) = do
                          , _hd_uniqIdBdd = Nothing
                          , _hd_page = Nothing
                          , _hd_title = Just $ intercalate " " _corpus_title
-                         , _hd_authors = Just $ foldl (\x y -> x <> ", " <> y) "" _corpus_authors_names
-                         , _hd_institutes = Just $ foldl (\x y -> x <> ", " <> y) "" $ _corpus_authors_affiliations <> map show _corpus_struct_id
+                         , _hd_authors = Just $ foldl (\x y -> if x == "" then y else x <> ", " <> y) "" _corpus_authors_names
+                         , _hd_institutes = Just $ foldl (\x y -> if x == "" then y else x <> ", " <> y) "" $ _corpus_authors_affiliations <> map show _corpus_struct_id
                          , _hd_source = Just $ maybe "Nothing" identity _corpus_source
                          , _hd_abstract = Just abstract
                          , _hd_publication_date = fmap show utctime

src/Gargantext/Core/Text/Corpus/API/Pubmed.hs

@@ -97,7 +97,9 @@ get apiKey q l = do
   eRes <- runReaderT PubMed.getMetadataWithC (Config { apiKey  = Just apiKey
                                                      , query   = getRawQuery q
                                                      , perPage = Just 200
-                                                     , mWebEnv = Nothing })
+                                                     , mWebEnv = Nothing
+                                                     , enableDebugLogs = False
+                                                     })
   let takeLimit = case l of
         Nothing -> mapC identity
         Just l' -> takeC $ getLimit l'

src/Gargantext/Core/Text/Corpus/Parsers/Date.hs

@@ -24,7 +24,7 @@ module Gargantext.Core.Text.Corpus.Parsers.Date
 
 import Data.Aeson (toJSON, Value)
 import Data.Aeson qualified as Json
-import Data.HashMap.Strict as HM hiding (map)
+import Data.Aeson.KeyMap as KM hiding (map)
 import Data.HashSet qualified as HashSet
 import Data.List qualified as List
 import Data.Text (unpack, splitOn, replace)
@@ -184,7 +184,7 @@ getTimeValue rt = case head rt of
 
 extractValue :: Maybe Value -> Maybe Text
 extractValue (Just (Json.Object object)) =
-  case HM.lookup "value" object of
+  case KM.lookup "value" object of
     Just (Json.String date) -> Just date
     _                  -> Nothing
 extractValue _ = Nothing

src/Gargantext/Core/Text/Corpus/Parsers/JSON/Istex.hs

@@ -41,9 +41,9 @@ toDoc la (ISTEX.Document i t a ab d s) = do
                            , _hd_uniqIdBdd = Nothing
                            , _hd_page      = Nothing
                            , _hd_title     = t
-                           , _hd_authors = Just $ foldl (\x y -> x <> ", " <> y) "" (map ISTEX._author_name a)
-                           , _hd_institutes = Just $ foldl (\x y -> x <> ", " <> y) "" (concat $ (map ISTEX._author_affiliations) a)
-                           , _hd_source = Just $ foldl (\x y -> x <> ", " <> y) "" (catMaybes $ map ISTEX._source_title s)
+                           , _hd_authors = Just $ foldl (\x y -> if x == "" then y else x <> ", " <> y) "" (map ISTEX._author_name a)
+                           , _hd_institutes = Just $ foldl (\x y -> if x == "" then y else x <> ", " <> y) "" (concat $ (map ISTEX._author_affiliations) a)
+                           , _hd_source = Just $ foldl (\x y -> if x == "" then y else x <> ", " <> y) "" (ISTEX._source_title s)
                            , _hd_abstract = ab
                            , _hd_publication_date = fmap (T.pack . show) utctime
                            , _hd_publication_year = pub_year

src/Gargantext/Core/Text/Terms/Eleve.hs

@@ -34,10 +34,11 @@ Notes for current implementation:
 
 {-# OPTIONS_GHC -fno-warn-deprecations #-}
 
-{-# LANGUAGE ConstraintKinds   #-}
-{-# LANGUAGE StandaloneDeriving   #-}
-{-# LANGUAGE TemplateHaskell   #-}
-{-# LANGUAGE TypeFamilies      #-}
+{-# LANGUAGE ConstraintKinds     #-}
+{-# LANGUAGE StandaloneDeriving  #-}
+{-# LANGUAGE TemplateHaskell     #-}
+{-# LANGUAGE TypeFamilies        #-}
+{-# LANGUAGE TypeOperators       #-}
 
 module Gargantext.Core.Text.Terms.Eleve where
 

src/Gargantext/Core/Text/Terms/Mono/Token/En.hs

@@ -143,11 +143,11 @@ whitespace :: Tokenizer
 whitespace xs = E [Right w | w <- T.words xs ]
 
 instance Monad (EitherList a) where
-    return x = E [Right x]
+    return = pure
     E xs >>= f = E $ concatMap (either (return . Left) (unE . f)) xs
 
 instance Applicative (EitherList a) where
-    pure = pure
+    pure x = E [Right x]
     f <*> x = f `ap` x
 
 instance Functor (EitherList a) where

src/Gargantext/Core/Types/Phylo.hs

@@ -216,43 +216,6 @@ data ObjectData =
   | Layer        !GvId !GraphDataData  !LayerData
   deriving (Show, Eq, Generic)
 
-instance ToJSON ObjectData where
-  toJSON = \case
-    GroupToNode gvid commonData nodeTypeData
-      -> mkObject gvid (Left commonData) nodeTypeData
-    BranchToNode gvid commonData nodeTypeData
-      -> mkObject gvid (Left commonData) nodeTypeData
-    PeriodToNode gvid commonData nodeTypeData
-      -> mkObject gvid (Left commonData) nodeTypeData
-    Layer gvid graphData nodeTypeData
-      -> mkObject gvid (Right graphData) nodeTypeData
-
-instance FromJSON ObjectData where
-  parseJSON = withObject "ObjectData" $ \o -> do
-    _gvid        <- o .: "_gvid"
-    -- try to parse the graph data first. If we succeed, then we are dealing with
-    -- the 'Layer', otherwise we the rest, but for the rest we can avoid re-parsing
-    -- the 'NodeCommonData' every time.
-    case parseMaybe @_ @GraphDataData parseJSON (Object o) of
-      Nothing
-        -> do commonData <- parseJSON (Object o)
-              ((GroupToNode  <$> pure _gvid <*> pure commonData <*> parseJSON (Object o)) <|>
-               (BranchToNode <$> pure _gvid <*> pure commonData <*> parseJSON (Object o)) <|>
-               (PeriodToNode <$> pure _gvid <*> pure commonData <*> parseJSON (Object o)))
-      Just gd
-        -> Layer <$> pure _gvid <*> pure gd <*> parseJSON (Object o)
-
-
-mkObject :: ToJSON a => GvId -> Either NodeCommonData GraphDataData -> a -> Value
-mkObject gvid commonData objectTypeData =
-  let commonDataJSON   = either toJSON toJSON commonData
-      objectTypeDataJSON = toJSON objectTypeData
-      header           = object $ [ "_gvid"    .= toJSON gvid ]
-  in case (commonDataJSON, objectTypeDataJSON, header) of
-    (Object hdr, Object cdJSON, Object etDataJSON)
-      -> Object $ hdr <> cdJSON <> etDataJSON
-    _ -> panicTrace "[Gargantext.Core.Types.Phylo.mkObject] impossible: commonData, header or objectTypeDataJSON didn't convert back to JSON Object."
-
 data GroupToNodeData
   = GroupToNodeData
     { _gtn_bId        :: Text
@@ -474,17 +437,23 @@ data BranchToGroupData
     , _btg_style :: Maybe Text
     } deriving (Show, Eq, Generic)
 
--- | Lenses
-makeLenses ''Phylo
-makeLenses ''PhyloPeriod
-makeLenses ''PhyloLevel
-makeLenses ''PhyloGroup
-
 -- | JSON instances
-$(deriveJSON (unPrefix "_phylo_"       ) ''Phylo       )
-$(deriveJSON (unPrefix "_phylo_Period" ) ''PhyloPeriod )
-$(deriveJSON (unPrefix "_phylo_Level"  ) ''PhyloLevel  )
-$(deriveJSON (unPrefix "_phylo_Group"  ) ''PhyloGroup  )
+instance ToJSON GvId where
+  toJSON GvId{..} = toJSON _GvId
+instance FromJSON GvId where
+  parseJSON v = GvId <$> parseJSON v
+
+-- /NOTE/ We need to define /after/ the JSON istance for 'GvId' due to GHC stage limitation.
+mkObject :: ToJSON a => GvId -> Either NodeCommonData GraphDataData -> a -> Value
+mkObject gvid commonData objectTypeData =
+  let commonDataJSON   = either toJSON toJSON commonData
+      objectTypeDataJSON = toJSON objectTypeData
+      header           = object $ [ "_gvid"    .= toJSON gvid ]
+  in case (commonDataJSON, objectTypeDataJSON, header) of
+    (Object hdr, Object cdJSON, Object etDataJSON)
+      -> Object $ hdr <> cdJSON <> etDataJSON
+    _ -> panicTrace "[Gargantext.Core.Types.Phylo.mkObject] impossible: commonData, header or objectTypeDataJSON didn't convert back to JSON Object."
+
 
 instance ToJSON GraphData where
   toJSON = mkGraphData
@@ -512,11 +481,6 @@ instance FromJSON GraphData where
     _gd_data          <- parseJSON (Object o)
     pure GraphData{..}
 
-instance ToJSON GvId where
-  toJSON GvId{..} = toJSON _GvId
-instance FromJSON GvId where
-  parseJSON v = GvId <$> parseJSON v
-
 instance ToJSON EdgeData where
   toJSON = \case
     GroupToAncestor gvid commonData edgeTypeData
@@ -608,6 +572,38 @@ instance FromJSON BranchToGroupData where
     _btg_style     <- o .:? "style"
     pure BranchToGroupData{..}
 
+instance ToJSON ObjectData where
+  toJSON = \case
+    GroupToNode gvid commonData nodeTypeData
+      -> mkObject gvid (Left commonData) nodeTypeData
+    BranchToNode gvid commonData nodeTypeData
+      -> mkObject gvid (Left commonData) nodeTypeData
+    PeriodToNode gvid commonData nodeTypeData
+      -> mkObject gvid (Left commonData) nodeTypeData
+    Layer gvid graphData nodeTypeData
+      -> mkObject gvid (Right graphData) nodeTypeData
+
+instance FromJSON ObjectData where
+  parseJSON = withObject "ObjectData" $ \o -> do
+    _gvid        <- o .: "_gvid"
+    -- try to parse the graph data first. If we succeed, then we are dealing with
+    -- the 'Layer', otherwise we the rest, but for the rest we can avoid re-parsing
+    -- the 'NodeCommonData' every time.
+    case parseMaybe @_ @GraphDataData parseJSON (Object o) of
+      Nothing
+        -> do commonData <- parseJSON (Object o)
+              ((GroupToNode  <$> pure _gvid <*> pure commonData <*> parseJSON (Object o)) <|>
+               (BranchToNode <$> pure _gvid <*> pure commonData <*> parseJSON (Object o)) <|>
+               (PeriodToNode <$> pure _gvid <*> pure commonData <*> parseJSON (Object o)))
+      Just gd
+        -> Layer <$> pure _gvid <*> pure gd <*> parseJSON (Object o)
+
+
+
+$(deriveJSON (unPrefix "_phylo_Group"  ) ''PhyloGroup  )
+$(deriveJSON (unPrefix "_phylo_Level"  ) ''PhyloLevel  )
+$(deriveJSON (unPrefix "_phylo_Period" ) ''PhyloPeriod )
+$(deriveJSON (unPrefix "_phylo_"       ) ''Phylo       )
 
 -- | ToSchema instances
 instance ToSchema Phylo where
@@ -637,7 +633,9 @@ instance ToSchema GraphDataData where
 instance ToSchema GraphData where
   declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_gd_")
 
--- | Arbitrary instances
+--
+-- Arbitrary instances
+--
 instance Arbitrary LayerData where
   arbitrary = LayerData <$> arbitrary
 instance Arbitrary NodeCommonData where
@@ -723,3 +721,13 @@ instance Arbitrary GraphDataData where
                             <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
                             <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
                             <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
+
+--
+-- Lenses
+--
+
+makeLenses ''Phylo
+makeLenses ''PhyloPeriod
+makeLenses ''PhyloLevel
+makeLenses ''PhyloGroup
+

src/Gargantext/Core/Viz/LegacyPhylo.hs

@@ -475,38 +475,38 @@ makeLenses ''PhyloEdge
 ------------------------
 
 
-$(deriveJSON (unPrefix "_phylo_"       ) ''Phylo       )
+$(deriveJSON (unPrefix "_phylo_group"  ) ''PhyloGroup  )
+$(deriveJSON (unPrefix "_phylo_level"  ) ''PhyloLevel  )
 $(deriveJSON (unPrefix "_phylo_foundations"  ) ''PhyloFoundations  )
 $(deriveJSON (unPrefix "_phylo_period" ) ''PhyloPeriod )
-$(deriveJSON (unPrefix "_phylo_level"  ) ''PhyloLevel  )
-$(deriveJSON (unPrefix "_phylo_group"  ) ''PhyloGroup  )
 $(deriveJSON (unPrefix "_phyloFis_"    ) ''PhyloFis    )
 --
-$(deriveJSON (unPrefix "_software_"    ) ''Software    )
-$(deriveJSON (unPrefix "_phyloParam_"  ) ''PhyloParam  )
+$(deriveJSON (unPrefix "_lb_" )      ''LBParams      )
+$(deriveJSON (unPrefix "_sb_" )      ''SBParams      )
+--
+$(deriveJSON (unPrefix "_fis_" )     ''FisParams     )
+$(deriveJSON (unPrefix "_hamming_" ) ''HammingParams )
+$(deriveJSON (unPrefix "_wlj_" )     ''WLJParams     )
 --
 $(deriveJSON defaultOptions ''Filter    )
 $(deriveJSON defaultOptions ''Metric    )
-$(deriveJSON defaultOptions ''Cluster   )
 $(deriveJSON defaultOptions ''Proximity )
---
-$(deriveJSON (unPrefix "_fis_" )     ''FisParams     )
-$(deriveJSON (unPrefix "_hamming_" ) ''HammingParams )
 $(deriveJSON (unPrefix "_louvain_" ) ''LouvainParams )
 $(deriveJSON (unPrefix "_rc_" )      ''RCParams      )
-$(deriveJSON (unPrefix "_wlj_" )     ''WLJParams     )
+$(deriveJSON defaultOptions ''Cluster   )
+$(deriveJSON (unPrefix "_q_" )  ''PhyloQueryBuild  )
 --
-$(deriveJSON (unPrefix "_lb_" )      ''LBParams      )
-$(deriveJSON (unPrefix "_sb_" )      ''SBParams      )
+$(deriveJSON (unPrefix "_software_"    ) ''Software    )
+$(deriveJSON (unPrefix "_phyloParam_"  ) ''PhyloParam  )
+$(deriveJSON (unPrefix "_phylo_"       ) ''Phylo       )
 --
-$(deriveJSON (unPrefix "_q_" )  ''PhyloQueryBuild  )
-$(deriveJSON (unPrefix "_pv_" ) ''PhyloView   )
 $(deriveJSON (unPrefix "_pb_" ) ''PhyloBranch )
-$(deriveJSON (unPrefix "_pe_" ) ''PhyloEdge   )
-$(deriveJSON (unPrefix "_pn_" ) ''PhyloNode   )
-
 $(deriveJSON defaultOptions ''Filiation )
+$(deriveJSON (unPrefix "_pn_" ) ''PhyloNode   )
 $(deriveJSON defaultOptions ''EdgeType  )
+$(deriveJSON (unPrefix "_pe_" ) ''PhyloEdge   )
+$(deriveJSON (unPrefix "_pv_" ) ''PhyloView   )
+
 
 ---------------------------
 -- | Swagger instances | --

src/Gargantext/Core/Viz/Phylo.hs

@@ -625,9 +625,6 @@ makeLenses ''PhyloBranch
 -- | JSON instances | --
 ------------------------
 
-instance FromJSON Phylo
-instance ToJSON Phylo
-
 instance FromJSON PhyloSources
 instance ToJSON PhyloSources
 
@@ -651,6 +648,9 @@ instance ToJSON PhyloGroup
 
 $(deriveJSON (unPrefix "_foundations_"  ) ''PhyloFoundations)
 
+instance FromJSON Phylo
+instance ToJSON Phylo
+
 -- NFData instances
 
 instance NFData CorpusParser
@@ -677,3 +677,4 @@ instance NFData Order
 instance NFData Sort
 instance NFData Tagger
 instance NFData PhyloLabel
+

src/Gargantext/Core/Viz/Phylo/API/Tools.hs

@@ -114,7 +114,7 @@ corpusIdtoDocuments timeUnit corpusId = do
   docs <- selectDocNodes corpusId
   lId  <- defaultList corpusId
   termList <- getTermList lId MapTerm NgramsTerms
-  corpus_node <- getNodeWith corpusId (Proxy @ HyperdataCorpus)
+  corpus_node <- getNodeWith corpusId (Proxy @HyperdataCorpus)
   let corpusLang = view (node_hyperdata . to _hc_lang) corpus_node
 
   let patterns = case termList of

src/Gargantext/Core/Viz/Phylo/Legacy/LegacyMain.hs

@@ -46,7 +46,7 @@ flowPhylo :: (HasNodeStory env err m, HasDBid NodeType)
           -> m Phylo
 flowPhylo cId = do
 
-  corpus_node <- getNodeWith cId (Proxy @ HyperdataCorpus)
+  corpus_node <- getNodeWith cId (Proxy @HyperdataCorpus)
   let lang = withDefaultLanguage $ view (node_hyperdata . to _hc_lang) corpus_node
   list'    <- defaultList cId
   termList <- HashMap.toList <$> getTermsWith (Text.words . unNgramsTerm) [list'] NgramsTerms (Set.singleton MapTerm)

src/Gargantext/Database/Action/Flow.hs

@@ -659,7 +659,7 @@ reIndexWith :: ( HasNodeStory env err m )
             -> m ()
 reIndexWith cId lId nt lts = do
   -- printDebug "(cId,lId,nt,lts)" (cId, lId, nt, lts)
-  corpus_node <- getNodeWith cId (Proxy @ HyperdataCorpus)
+  corpus_node <- getNodeWith cId (Proxy @HyperdataCorpus)
   let corpusLang = withDefaultLanguage $ view (node_hyperdata . to _hc_lang) corpus_node
 
   -- Getting [NgramsTerm]

src/Gargantext/Database/Admin/Types/Hyperdata/Contact.hs

@@ -193,6 +193,20 @@ instance Arbitrary HyperdataContact where
 -- | Specific Gargantext instance
 instance Hyperdata HyperdataContact
 
+-- | All lenses
+makeLenses ''ContactWho
+makeLenses ''ContactWhere
+makeLenses ''ContactTouch
+makeLenses ''ContactMetaData
+makeLenses ''HyperdataContact
+
+-- | All Json instances
+$(deriveJSON (unPrefix "_ct_") ''ContactTouch)
+$(deriveJSON (unPrefix "_cw_") ''ContactWho)
+$(deriveJSON (unPrefix "_cw_") ''ContactWhere)
+$(deriveJSON (unPrefix "_cm_") ''ContactMetaData)
+$(deriveJSON (unPrefix "_hc_") ''HyperdataContact)
+
 -- | Database (Posgresql-simple instance)
 instance FromField HyperdataContact where
   fromField = fromField'
@@ -207,16 +221,3 @@ instance DefaultFromField (Nullable SqlJsonb) HyperdataContact where
 
 
 
--- | All lenses
-makeLenses ''ContactWho
-makeLenses ''ContactWhere
-makeLenses ''ContactTouch
-makeLenses ''ContactMetaData
-makeLenses ''HyperdataContact
-
--- | All Json instances
-$(deriveJSON (unPrefix "_cw_") ''ContactWho)
-$(deriveJSON (unPrefix "_cw_") ''ContactWhere)
-$(deriveJSON (unPrefix "_ct_") ''ContactTouch)
-$(deriveJSON (unPrefix "_cm_") ''ContactMetaData)
-$(deriveJSON (unPrefix "_hc_") ''HyperdataContact)

src/Gargantext/Database/Admin/Types/Hyperdata/Document.hs

@@ -73,8 +73,6 @@ defaultHyperdataDocument = case decode docExample of
 data StatusV3  = StatusV3 { statusV3_error  :: !(Maybe Text)
                           , statusV3_action :: !(Maybe Text)
                       } deriving (Show, Generic)
-$(deriveJSON (unPrefix "statusV3_") ''StatusV3)
-
 
 ------------------------------------------------------------------------
 data HyperdataDocumentV3 = HyperdataDocumentV3 { _hdv3_publication_day    :: !(Maybe Int)
@@ -140,12 +138,25 @@ arbitraryHyperdataDocuments =
 instance Hyperdata HyperdataDocument
 instance Hyperdata HyperdataDocumentV3
 ------------------------------------------------------------------------
-$(makeLenses ''HyperdataDocument)
-makePrisms ''HyperdataDocument
+-- $(deriveJSON (unPrefix "_hd_") ''HyperdataDocument)
+instance ToSchema HyperdataDocument where
+  declareNamedSchema proxy =
+    genericDeclareNamedSchema (unPrefixSwagger "_hd_") proxy
+    & mapped.schema.description ?~ "Document Hyperdata"
+    & mapped.schema.example ?~ toJSON defaultHyperdataDocument
 
-$(makeLenses ''HyperdataDocumentV3)
+{-
+-- | For now HyperdataDocumentV3 is not exposed with the API
+instance ToSchema HyperdataDocumentV3 where
+  declareNamedSchema proxy =
+    genericDeclareNamedSchema (unPrefixSwagger "hyperdataDocumentV3_") proxy
+    & mapped.schema.description ?~ "Document Hyperdata for Garg V3"
+    & mapped.schema.example ?~ toJSON defaultHyperdataDocumentV3
+-}
 
--- $(deriveJSON (unPrefix "_hd_") ''HyperdataDocument)
+--
+-- JSON instances
+--
 
 instance FromJSON HyperdataDocument
   where
@@ -167,24 +178,13 @@ instance ToJSON HyperdataDocument
 
 
 
+$(deriveJSON (unPrefix "statusV3_") ''StatusV3)
 $(deriveJSON (unPrefix "_hdv3_") ''HyperdataDocumentV3)
 
-instance ToSchema HyperdataDocument where
-  declareNamedSchema proxy =
-    genericDeclareNamedSchema (unPrefixSwagger "_hd_") proxy
-    & mapped.schema.description ?~ "Document Hyperdata"
-    & mapped.schema.example ?~ toJSON defaultHyperdataDocument
+--
+-- FromField/ToField instances
+--
 
-{-
--- | For now HyperdataDocumentV3 is not exposed with the API
-instance ToSchema HyperdataDocumentV3 where
-  declareNamedSchema proxy =
-    genericDeclareNamedSchema (unPrefixSwagger "hyperdataDocumentV3_") proxy
-    & mapped.schema.description ?~ "Document Hyperdata for Garg V3"
-    & mapped.schema.example ?~ toJSON defaultHyperdataDocumentV3
--}
-
-------------------------------------------------------------------------
 instance FromField HyperdataDocument
   where
     fromField = fromField'
@@ -193,14 +193,12 @@ instance FromField HyperdataDocumentV3
   where
     fromField = fromField'
 
--------
 instance ToField HyperdataDocument where
   toField = toJSONField
 
 instance ToField HyperdataDocumentV3 where
   toField = toJSONField
 
-------------------------------------------------------------------------
 instance DefaultFromField SqlJsonb HyperdataDocument
   where
     defaultFromField = fromPGSFromField
@@ -208,4 +206,10 @@ instance DefaultFromField SqlJsonb HyperdataDocument
 instance DefaultFromField SqlJsonb HyperdataDocumentV3
   where
     defaultFromField = fromPGSFromField
-------------------------------------------------------------------------
+
+--
+-- Lenses
+--
+$(makeLenses ''HyperdataDocument)
+makePrisms ''HyperdataDocument
+$(makeLenses ''HyperdataDocumentV3)

src/Gargantext/Database/Admin/Types/Hyperdata/User.hs

@@ -98,9 +98,9 @@ makeLenses ''HyperdataPrivate
 makeLenses ''HyperdataPublic
 
 -- | All Json instances
-$(deriveJSON (unPrefix "_hu_")  ''HyperdataUser)
 $(deriveJSON (unPrefix "_hpr_") ''HyperdataPrivate)
 $(deriveJSON (unPrefix "_hpu_") ''HyperdataPublic)
+$(deriveJSON (unPrefix "_hu_")  ''HyperdataUser)
 
 -- | Arbitrary instances
 instance Arbitrary HyperdataUser where

src/Gargantext/Database/Admin/Types/Metrics.hs

@@ -41,8 +41,8 @@ instance Arbitrary Metric
                        <*> arbitrary
                        <*> arbitrary
 
-deriveJSON (unPrefix "metrics_") ''Metrics
 deriveJSON (unPrefix "m_") ''Metric
+deriveJSON (unPrefix "metrics_") ''Metrics
 
 
 newtype ChartMetrics a = ChartMetrics { chartMetrics_data :: a }

src/Gargantext/Database/Prelude.hs

@@ -119,7 +119,7 @@ fromInt64ToInt = fromIntegral
 mkCmd :: (Connection -> IO a) -> DBCmd err a
 mkCmd k = do
   pool <- view connPool
-  withResource pool (liftBase . k)
+  liftBase $ withResource pool (liftBase . k)
 
 runCmd :: (HasConnectionPool env)
        => env

src/Gargantext/Database/Query/Facet.hs

@@ -15,6 +15,7 @@ Portability : POSIX
 {-# LANGUAGE NoMonomorphismRestriction #-}
 {-# LANGUAGE TemplateHaskell           #-}
 {-# LANGUAGE TypeFamilies              #-}
+{-# LANGUAGE TypeOperators             #-}
 ------------------------------------------------------------------------
 module Gargantext.Database.Query.Facet
   ( runViewAuthorsDoc

src/Gargantext/Database/Schema/User.hs

@@ -121,11 +121,11 @@ userTable = Table "auth_user"
                   }
       )
 
+$(deriveJSON (unPrefix "userLight_") ''UserLight)
+$(deriveJSON (unPrefix "user_") ''UserPoly)
+
 instance FromField UserLight where
   fromField = fromField'
 
 instance FromField UserDB where
   fromField = fromField'
-
-$(deriveJSON (unPrefix "userLight_") ''UserLight)
-$(deriveJSON (unPrefix "user_") ''UserPoly)

src/Gargantext/Utils/Jobs.hs

@@ -10,6 +10,7 @@ Portability : POSIX
 
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
 module Gargantext.Utils.Jobs (
   -- * Serving the JOBS API
     serveJobsAPI

src/Gargantext/Utils/Jobs/Internal.hs

@@ -20,8 +20,10 @@ import Data.Kind (Type)
 import Data.Sequence (Seq)
 import qualified Data.Sequence as Seq
 import Prelude
-import Servant.API
+import Servant.API.Alternative
+import Servant.API.ContentTypes
 
+import Gargantext.API.Errors.Types (BackendInternalError)
 import Gargantext.Utils.Jobs.Map
 import Gargantext.Utils.Jobs.Monad
 
@@ -33,16 +35,16 @@ import qualified Servant.Job.Core as SJ
 import qualified Servant.Job.Types as SJ
 
 serveJobsAPI
-  :: ( Ord t, Exception e, MonadError e m
+  :: ( Ord t, MonadError BackendInternalError m
      , MonadJob m t (Seq event) output
-     , ToJSON e, ToJSON event, ToJSON output
+     , ToJSON event, ToJSON output, MimeRender JSON output
      , Foldable callback
      )
   => (SJ.JobID 'SJ.Safe -> LoggerM m event -> JobHandle m)
   -> m env
   -> t
-  -> (JobError -> e)
-  -> (env -> JobHandle m -> input -> IO (Either e output))
+  -> (JobError -> BackendInternalError)
+  -> (env -> JobHandle m -> input -> IO (Either BackendInternalError output))
   -> SJ.AsyncJobsServerT' ctI ctO callback event input output m
 serveJobsAPI newJobHandle getenv t joberr f
      = newJob newJobHandle getenv t f (SJ.JobInput undefined Nothing)
@@ -50,10 +52,10 @@ serveJobsAPI newJobHandle getenv t joberr f
   :<|> serveJobAPI t joberr
 
 serveJobAPI
-  :: forall (m :: Type -> Type) e t event output.
-     (Ord t, MonadError e m, MonadJob m t (Seq event) output)
+  :: forall (m :: Type -> Type) t event output.
+     (Ord t, MonadError BackendInternalError m, MonadJob m t (Seq event) output, MimeRender JSON output)
   => t
-  -> (JobError -> e)
+  -> (JobError -> BackendInternalError)
   -> SJ.JobID 'SJ.Unsafe
   -> SJ.AsyncJobServerT event output m
 serveJobAPI t joberr jid' = wrap' (killJob t)
@@ -72,14 +74,15 @@ serveJobAPI t joberr jid' = wrap' (killJob t)
         wrap' g limit offset = wrap (g limit offset)
 
 newJob
-  :: ( Ord t, Exception e, MonadJob m t (Seq event) output
-     , ToJSON e, ToJSON event, ToJSON output
+  :: ( Ord t, MonadJob m t (Seq event) output
+     , ToJSON event, ToJSON output
+     , MimeRender JSON output
      , Foldable callbacks
      )
   => (SJ.JobID 'SJ.Safe -> LoggerM m event -> JobHandle m)
   -> m env
   -> t
-  -> (env -> JobHandle m -> input -> IO (Either e output))
+  -> (env -> JobHandle m -> input -> IO (Either BackendInternalError output))
   -> SJ.JobInput callbacks input
   -> m (SJ.JobStatus 'SJ.Safe event)
 newJob newJobHandle getenv jobkind f input = do

src/Gargantext/Utils/SpacyNLP.hs

@@ -15,71 +15,24 @@ Server to be used: https://gitlab.iscpif.fr/gargantext/spacy-server
 
 {-# LANGUAGE TemplateHaskell   #-}
 
-module Gargantext.Utils.SpacyNLP where
+module Gargantext.Utils.SpacyNLP (
+    module Gargantext.Utils.SpacyNLP.Types
+  , spacyRequest
+  , spacyTagsToToken
+  , spacyDataToPosSentences
+  , nlp
+  ) where
 
-import Control.Lens
 import Data.Aeson (encode)
-import Data.Aeson.TH (deriveJSON)
 import Data.Text hiding (map, group, filter, concat, zip)
 import Gargantext.Core (Lang(..))
 import Gargantext.Core.Text.Terms.Multi.PosTagging.Types
-import Gargantext.Core.Types (POS(..), NER(..))
-import Gargantext.Core.Utils.Prefix (unPrefix)
 import Gargantext.Prelude
 import Network.HTTP.Simple (parseRequest, httpJSON, setRequestBodyLBS, getResponseBody, Response)
 import Network.URI (URI(..))
+import Gargantext.Utils.SpacyNLP.Types
 
 
-data SpacyData = SpacyData { _spacy_data :: ![SpacyText]}
-  deriving (Show)
-
-data SpacyText = SpacyText { _spacy_text :: !Text
-                           , _spacy_tags :: ![SpacyTags]
-                           } deriving (Show)
-data SpacyTags =
-  SpacyTags { _spacyTags_text :: !Text
-            , _spacyTags_text_with_ws :: !Text
-            , _spacyTags_whitespace :: !Text
-            , _spacyTags_head :: !Text
-            , _spacyTags_head_index :: !Int
-            , _spacyTags_left_edge :: !Text
-            , _spacyTags_right_edge :: !Text
-            , _spacyTags_index :: Int
-            , _spacyTags_ent_type :: !NER
-            , _spacyTags_ent_iob :: !Text
-            , _spacyTags_lemma :: !Text
-            , _spacyTags_normalized :: !Text
-            , _spacyTags_shape :: !Text
-            , _spacyTags_prefix :: !Text
-            , _spacyTags_suffix :: !Text
-            , _spacyTags_is_alpha :: Bool
-            , _spacyTags_is_ascii :: Bool
-            , _spacyTags_is_digit :: Bool
-            , _spacyTags_is_title :: Bool
-            , _spacyTags_is_punct :: Bool
-            , _spacyTags_is_left_punct :: Bool
-            , _spacyTags_is_right_punct :: Bool
-            , _spacyTags_is_space :: Bool
-            , _spacyTags_is_bracket :: Bool
-            , _spacyTags_is_quote :: Bool
-            , _spacyTags_is_currency :: Bool
-            , _spacyTags_like_url :: Bool
-            , _spacyTags_like_num :: Bool
-            , _spacyTags_like_email :: Bool
-            , _spacyTags_is_oov :: Bool
-            , _spacyTags_is_stop :: Bool
-            , _spacyTags_pos :: POS
-            , _spacyTags_tag :: POS
-            , _spacyTags_dep :: !Text
-            , _spacyTags_lang :: !Text
-            , _spacyTags_prob :: !Int
-            , _spacyTags_char_offset :: !Int
-            } deriving (Show)
-
-
-data SpacyRequest = SpacyRequest { _spacyRequest_text :: !Text }
-  deriving (Show)
-
 spacyRequest :: URI -> Text -> IO SpacyData
 spacyRequest uri txt = do
   req <- parseRequest $ "POST " <> show (uri { uriPath = "/pos" })
@@ -87,30 +40,18 @@ spacyRequest uri txt = do
   result <- httpJSON request :: IO (Response SpacyData)
   pure $ getResponseBody result
 
-
--- Instances
-deriveJSON (unPrefix "_spacy_")        ''SpacyData
-deriveJSON (unPrefix "_spacy_")        ''SpacyText
-deriveJSON (unPrefix "_spacyTags_")    ''SpacyTags
-deriveJSON (unPrefix "_spacyRequest_") ''SpacyRequest
-
-makeLenses ''SpacyData
-makeLenses ''SpacyText
-makeLenses ''SpacyTags
-makeLenses ''SpacyRequest
-
 ----------------------------------------------------------------
 spacyTagsToToken :: SpacyTags -> Token
-spacyTagsToToken st = Token (st ^. spacyTags_index)
-                   (st ^. spacyTags_normalized)
-                   (st ^. spacyTags_text)
-                   (st ^. spacyTags_lemma)
-                   (st ^. spacyTags_head_index)
-                   (st ^. spacyTags_char_offset)
-                   (Just $ st ^. spacyTags_pos)
-                   (Just $ st ^. spacyTags_ent_type)
-                   (Just $ st ^. spacyTags_prefix)
-                   (Just $ st ^. spacyTags_suffix)
+spacyTagsToToken st = Token (_spacyTags_index st)
+                   (_spacyTags_normalized st)
+                   (_spacyTags_text st)
+                   (_spacyTags_lemma st)
+                   (_spacyTags_head_index st)
+                   (_spacyTags_char_offset st)
+                   (Just $ _spacyTags_pos st)
+                   (Just $ _spacyTags_ent_type st)
+                   (Just $ _spacyTags_prefix st)
+                   (Just $ _spacyTags_suffix st)
 
 spacyDataToPosSentences :: SpacyData -> PosSentences
 spacyDataToPosSentences (SpacyData ds) = PosSentences

src/Gargantext/Utils/SpacyNLP/Types.hs

+{-|
+Module      : Gargantext.Utils.SpacyNLP.Types
+Description : John Snow NLP API connexion
+Copyright   : (c) CNRS, 2017
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+
+Spacy ecosystem: https://github.com/explosion/spaCy
+
+Server to be used: https://gitlab.iscpif.fr/gargantext/spacy-server
+
+-}
+
+{-# LANGUAGE TemplateHaskell   #-}
+
+module Gargantext.Utils.SpacyNLP.Types where
+
+import Control.Lens
+import Data.Aeson.TH (deriveJSON)
+import Data.Text hiding (map, group, filter, concat, zip)
+import Gargantext.Core.Types (POS(..), NER(..))
+import Gargantext.Core.Utils.Prefix (unPrefix)
+import Gargantext.Prelude
+
+
+data SpacyData = SpacyData { _spacy_data :: ![SpacyText]}
+  deriving (Show)
+
+data SpacyText = SpacyText { _spacy_text :: !Text
+                           , _spacy_tags :: ![SpacyTags]
+                           } deriving (Show)
+data SpacyTags =
+  SpacyTags { _spacyTags_text :: !Text
+            , _spacyTags_text_with_ws :: !Text
+            , _spacyTags_whitespace :: !Text
+            , _spacyTags_head :: !Text
+            , _spacyTags_head_index :: !Int
+            , _spacyTags_left_edge :: !Text
+            , _spacyTags_right_edge :: !Text
+            , _spacyTags_index :: Int
+            , _spacyTags_ent_type :: !NER
+            , _spacyTags_ent_iob :: !Text
+            , _spacyTags_lemma :: !Text
+            , _spacyTags_normalized :: !Text
+            , _spacyTags_shape :: !Text
+            , _spacyTags_prefix :: !Text
+            , _spacyTags_suffix :: !Text
+            , _spacyTags_is_alpha :: Bool
+            , _spacyTags_is_ascii :: Bool
+            , _spacyTags_is_digit :: Bool
+            , _spacyTags_is_title :: Bool
+            , _spacyTags_is_punct :: Bool
+            , _spacyTags_is_left_punct :: Bool
+            , _spacyTags_is_right_punct :: Bool
+            , _spacyTags_is_space :: Bool
+            , _spacyTags_is_bracket :: Bool
+            , _spacyTags_is_quote :: Bool
+            , _spacyTags_is_currency :: Bool
+            , _spacyTags_like_url :: Bool
+            , _spacyTags_like_num :: Bool
+            , _spacyTags_like_email :: Bool
+            , _spacyTags_is_oov :: Bool
+            , _spacyTags_is_stop :: Bool
+            , _spacyTags_pos :: POS
+            , _spacyTags_tag :: POS
+            , _spacyTags_dep :: !Text
+            , _spacyTags_lang :: !Text
+            , _spacyTags_prob :: !Int
+            , _spacyTags_char_offset :: !Int
+            } deriving (Show)
+
+
+data SpacyRequest = SpacyRequest { _spacyRequest_text :: !Text }
+  deriving (Show)
+
+--
+-- JSON instances
+--
+
+deriveJSON (unPrefix "_spacyTags_")    ''SpacyTags
+deriveJSON (unPrefix "_spacy_")        ''SpacyText
+deriveJSON (unPrefix "_spacy_")        ''SpacyData
+deriveJSON (unPrefix "_spacyRequest_") ''SpacyRequest
+
+--
+-- Lenses
+--
+
+makeLenses ''SpacyData
+makeLenses ''SpacyText
+makeLenses ''SpacyTags
+makeLenses ''SpacyRequest
+

stack.yaml

-resolver: lts-18.28
+resolver: lts-21.17
 flags:
     accelerate:
         debug: false
+    wikiparsec:
+        library-only: true
 extra-package-dbs: []
 skip-ghc-check: true
+system-ghc: true
 packages:
 - .
 
-docker:
-  enable: false
-  repo: 'cgenie/stack-build:lts-18.18-garg'
-  run-args:
-    - '--publish=8008:8008'
-
-nix:
-  enable: false
-  add-gc-roots: true
-  shell-file: nix/stack-shell.nix
-
 allow-newer: true
 
 extra-deps:
 - git: https://gitlab.iscpif.fr/gargantext/haskell-gargantext-prelude
-  commit: 5a8dc3a0a1a4774ec2eb9df5f0f0b0a7dd172f09
+  commit: 618f711a530df56caefbb1577c4bf3d5ff45e214
 - git: https://gitlab.iscpif.fr/gargantext/iso639.git
   commit: eab929d106833ded8011a0d6705135e3fc506a9c
 - git: https://gitlab.iscpif.fr/gargantext/gargantext-graph.git
@@ -33,20 +25,8 @@ extra-deps:
 - git: https://gitlab.iscpif.fr/gargantext/hlcm.git
   commit: 6f0595d2421005837d59151a8b26eee83ebb67b5
   # API libs
-- git: https://github.com/haskell-servant/servant.git
-  commit: c2af6e775d1d36f2011d43aff230bb502f8fba63
-  subdirs:
-    - servant/
-    - servant-server/
-    - servant-client-core/
-    - servant-client/
-    - servant-auth/servant-auth/
-    - servant-auth/servant-auth-client/
-    - servant-auth/servant-auth-server/
 - git: https://gitlab.iscpif.fr/gargantext/servant-xml-conduit.git
   commit: 339fd608341bd2652cf5c0e9e76a3293acffbea6
-- git: https://github.com/alpmestan/ekg-json.git
-  commit: fd7e5d7325939103cd87d0dc592faf644160341c
   # Databases libs
 - git: https://github.com/adinapoli/haskell-opaleye.git
   commit: e9a29582ac66198dd2c2fdc3f8c8a4b1e6fbe004
@@ -54,13 +34,13 @@ extra-deps:
   commit: 4fd2edf30c141600ffad6d730cc4c1c08a6dbce4
   # External Data API connectors
 - git: https://gitlab.iscpif.fr/gargantext/crawlers/pubmed.git
-  commit: 234ad423fa682307ff4843ae4acd725dcc6ffc55
+  commit: 300764df4f78ea6175535f9b78b884cc2aa9da61
 - git: https://gitlab.iscpif.fr/gargantext/crawlers/istex.git
-  commit: 9b1bd17f3ed38eab83e675bb68278922217a9c73
+  commit: c0a08d62c40a169b7934ceb7cb12c39952160e7a
 - git: https://gitlab.iscpif.fr/gargantext/crawlers/hal.git
-  commit: 25a1e9558075462a82660987920a698b8863dd63
+  commit: bfa9069b4ff70f341ca3244e8aff9e83eb4b8b73
 - git: https://gitlab.iscpif.fr/gargantext/crawlers/isidore.git
-  commit: 3db385e767d2100d8abe900833c6e7de3ac55e1b
+  commit: e9b594a4718acc06db037f6d3f429a90db76c267
 - git: https://gitlab.iscpif.fr/gargantext/crawlers/arxiv-api.git
   commit: eb130c71fa17adaceed6ff66beefbccb13df51ba
 - git: https://gitlab.iscpif.fr/gargantext/crawlers/openalex.git
@@ -72,30 +52,31 @@ extra-deps:
   commit: b4182487cfe479777c11ca19f3c0d47840b376f6
 - git: https://github.com/delanoe/patches-map
   commit: 76cae88f367976ff091e661ee69a5c3126b94694
-- git: https://gitlab.iscpif.fr/cgenie/patches-class.git
-  commit: 125c7cb90ab8f0cd6ac4a526dbdf302d10c945e9
+- git: https://gitlab.iscpif.fr/gargantext/patches-class.git
+  commit: 3668d28607867a88b2dfc62158139b3cfd629ddb
   # Graph libs
 - git: https://gitlab.iscpif.fr/gargantext/haskell-igraph.git
-  # 0.10.4-rc1
-  commit: 2a28524134b68421f30f6e97961063018f814a82
+  # 0.10.4-rc2
+  commit: 9f8a2f4a014539826a4eab3215cc70c0813f20cb
 - git: https://gitlab.iscpif.fr/gargantext/haskell-infomap.git
   commit: 1370fea1939e2378ce344e512d80671ac700e787
   # Accelerate Linear Algebra and specific instances
-- git: https://github.com/alpmestan/accelerate.git
-  commit: 640b5af87cea94b61c7737d878e6f7f2fca5c015
+- git: https://github.com/AccelerateHS/accelerate.git
+  commit: 334d05519436bb7f20f9926ec76418f5b8afa359
 - git: https://github.com/alpmestan/accelerate-arithmetic.git
   commit: a110807651036ca2228a76507ee35bbf7aedf87a
 - git: https://gitlab.iscpif.fr/amestanogullari/accelerate-utility.git
   commit: a3875fe652d3bb5acb522674c22c6c814c1b4ad0
-- git: https://github.com/alpmestan/accelerate-llvm.git
-  commit: 944f5a4aea35ee6aedb81ea754bf46b131fce9e3
+- git: https://github.com/AccelerateHS/accelerate-llvm.git
+  commit: 2b5d69448557e89002c0179ea1aaf59bb757a6e3
   subdirs:
     - accelerate-llvm/
     - accelerate-llvm-native/
-- git: https://github.com/rspeer/wikiparsec.git
-  commit: 9637a82344bb70f7fa8f02e75db3c081ccd434ce
+- git: https://github.com/adinapoli/wikiparsec.git
+  commit: b3519a0351ae9515497680571f76200c24dedb53
   # Gargantext-graph
-- eigen-3.3.7.0@sha256:7c24a86426b238e02ba0ac2179cc44997518b443a13828ed7a791fe49a6dffa5,82060
+- git: https://github.com/chessai/eigen.git
+  commit: 8fff32a43df743c8c83428a86dd566a0936a4fba
 - git: https://github.com/alpmestan/sparse-linear.git
   commit: bc6ca8058077b0b5702ea4b88bd4189cfcad267a
   subdirs:
@@ -104,49 +85,75 @@ extra-deps:
   commit: b9fca8beee0f23c17a6b2001ec834d071709e6e7
   subdirs:
     - packages/base
+- git: https://github.com/adinapoli/llvm-hs.git
+  commit: 7533a9ccd3bfe77141745f6b61039a26aaf5c83b
+  subdirs:
+    - llvm-hs
+    - llvm-hs-pure
+  # Mercury is a reputable Haskell company.
+- git: https://github.com/MercuryTechnologies/ekg-json.git
+  commit: 232db57d6ce0940fcc902adf30a9ed3f3561f21d
   # Temporary fork of boolexpr
 - git: https://github.com/adinapoli/boolexpr.git
   commit: 91928b5d7f9342e9865dde0d94862792d2b88779
+  # Temporary fork of duckling
+- git: https://github.com/adinapoli/duckling.git
+  commit: 23603a832117e5352d5b0fb9bb1110228324b35a
+- git: https://github.com/adinapoli/text16-compat.git
+  commit: 85533b5d597e6fc5498411b4bcfc76380ec80d71
   # Others dependencies (using stack resolver)
-- HSvm-0.1.1.3.22
-- KMP-0.2.0.0@sha256:6dfbac03ef00ebd9347234732cb86a40f62ab5a80c0cc6bedb8eb51766f7df28,2562
-- MissingH-1.4.3.0@sha256:32f9892ec98cd21df4f4d3ed8d95a3831ae74287ea0641d6f09b2dc6ef061d39,4859
-- Unique-0.4.7.8@sha256:9661f45aa31dde119a2114566166ea38b011a45653337045ee4ced75636533c0,2067
-- constraints-extras-0.3.1.0@sha256:12016ebb91ad5ed2c82bf7e48c6bd6947d164d33c9dca5ac3965de1bb6c780c0,1777
 - context-0.2.0.0@sha256:6b643adb4a64fe521873d08df0497f71f88e18b9ecff4b68b4eef938e446cfc9,1886
 - dependent-sum-0.7.1.0@sha256:0e419237f5b86da3659772afff9cab355c0f8d5b3fdb15a5b30e673d8dc83941,2147
-- duckling-0.2.0.0@sha256:84becd4e48ee3676cdd6fe5745a77ee60e365ea730cd759610c8a7738f3eb4a6,60543
-- fast-tagsoup-utf8-only-1.0.5@sha256:9292c8ff275c08b88b6013ccc410182552f180904214a07ad4db932ab462aaa1,1651
-- fclabels-2.0.5@sha256:817006077632bd29e637956154aa33d3c10a59be0791c308cef955eb951b2675,4473
-- full-text-search-0.2.1.4@sha256:81f6df3327e5b604f99b15e78635e5d6ca996e504c21d268a6d751d7d131aa36,6032
+- fast-tagsoup-1.0.14@sha256:5aacc569a6ab9633077bb181f6bd6a4dde3ebc7a8b844d2fe7b1920a0cf0ba9f,1343
+- fclabels-2.0.5.1@sha256:0ec200ff51561ed6ee60fa52d47427cd4bbbb3ace618884465ce2b27840cc1d7,4621
 - fullstop-0.1.4@sha256:80a3e382ef53551bb936e7da8b2825621df0ea169af1212debcb0a90010b30c8,2044
-- ghc-clippy-plugin-0.0.0.1
+- full-text-search-0.2.1.4@sha256:81f6df3327e5b604f99b15e78635e5d6ca996e504c21d268a6d751d7d131aa36,6032
+- ghc-parser-0.2.6.0@sha256:0b0cbceb3bd2762cef201dc54ae302d7918bed23b2f85ffd99c1c8b6a9df32b6,1579
 - hgal-2.0.0.2@sha256:13d58afd0668b9cb881c612eff8488a0e289edd4bbffa893df4beee60cfeb73b,653
 - hsparql-0.3.8
-- hstatistics-0.3.1
 - hspec-2.11.1
 - hspec-core-2.11.1
 - hspec-discover-2.11.1
 - hspec-expectations-0.8.3
-- json-stream-0.4.2.4@sha256:8b7f17d54a6e1e6311756270f8bcf51e91bab4300945400de66118470dcf51b9,4716
+- hstatistics-0.3.1
+- HSvm-0.1.1.3.22
+- ihaskell-0.11.0.0
+- ipython-kernel-0.11.0.0
+- KMP-0.2.0.0@sha256:6dfbac03ef00ebd9347234732cb86a40f62ab5a80c0cc6bedb8eb51766f7df28,2562
 - located-base-0.1.1.1@sha256:7c6395f2b6fbf2d5f76c3514f774423838c0ea94e1c6a5530dd3c94b30c9d1c8,1904
 - logging-effect-1.3.12@sha256:72d168dd09887649ba9501627219b6027cbec2d5541931555b7885b133785ce3,1679
 - logict-0.8.0.0
+- MissingH-1.4.3.0@sha256:32f9892ec98cd21df4f4d3ed8d95a3831ae74287ea0641d6f09b2dc6ef061d39,4859
 - monad-logger-aeson-0.2.0.0
-- monoid-extras-0.5.1@sha256:438dbfd7b4dce47d8f0ca577f56caf94bd1e21391afa545cad09fe7cf2e5793d,2333
+- morpheus-graphql-0.24.3
+- morpheus-graphql-app-0.24.3
+- morpheus-graphql-client-0.24.3
+- morpheus-graphql-code-gen-0.24.3
+- morpheus-graphql-code-gen-utils-0.24.3
+- morpheus-graphql-core-0.24.3
+- morpheus-graphql-server-0.24.3
+- morpheus-graphql-subscriptions-0.24.3
+- morpheus-graphql-tests-0.24.3
 - rake-0.0.1@sha256:3380f6567fb17505d1095b7f32222c0b631fa04126ad39726c84262da99c08b3,2025
 - random-1.2.1
 - recover-rtti-0.4.3
-- servant-cassava-0.10.1@sha256:07e7b6ca67cf57dcb4a0041a399a25d058844505837c6479e01d62be59d01fdf,1665
+- servant-0.20.1
+- servant-auth-server-0.4.8.0@sha256:f21b8b6a0a31811f31d9b1c1e8a1ca68a0f470cab4ffe8b9c2a41b7649492bb2,5521
+- servant-auth-swagger-0.2.10.2@sha256:eda169d986faf562b6f43ac90d48c4fcf895dc235dd002d523ad582ec9be833f,2909
+- servant-client-core-0.20
 - servant-ekg-0.3.1@sha256:19bd9dc3943983da8e79d6f607614c68faea4054fb889d508c8a2b67b6bdd448,2203
 - servant-flatten-0.2@sha256:276896f7c5cdec5b8f8493f6205fded0cc602d050b58fdb09a6d7c85c3bb0837,1234
 - servant-mock-0.8.7@sha256:64cb3e52bbd51ab6cb25e3f412a99ea712c6c26f1efd117f01a8d1664df49c67,2306
+- servant-server-0.20
+- snap-server-1.1.2.1@sha256:8ea05b9b068c1e86be77073107eadc177d7eec93724963c063877478a062b229,15471
 - stemmer-0.5.2@sha256:823aec56249ec2619f60a2c0d1384b732894dbbbe642856d337ebfe9629a0efd,4082
 - taggy-0.2.1@sha256:7bc55ddba178971dc6052163597f0445a0a2b5b0ca0e84ce651d53d722e3c265,4662
 - taggy-lens-0.1.2@sha256:091ca81d02bd3d7fb493dce0148e1a38f25eb178a1ebd751043a23239e5e3265,3009
 - tasty-hspec-1.2.0.3
 - tmp-postgres-1.34.1.0
+- Unique-0.4.7.8@sha256:9661f45aa31dde119a2114566166ea38b011a45653337045ee4ced75636533c0,2067
 - vector-0.12.3.0@sha256:0ae2c1ba86f0077910be242ec6802cc3d7725fe7b2bea6987201aa3737b239b5,7953
+- wai-3.2.4
 
 # For the graph clustering
 ghc-options:

test/Test/API/Errors.hs

@@ -47,7 +47,7 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
                 | Status{..} <- simpleStatus
                 ->liftIO $ do
                     statusCode `shouldBe` 404
-                    simpleBody `shouldBe` [r|{"node":99,"error":"Node does not exist"}|]
+                    simpleBody `shouldBe` [r|{"error":"Node does not exist","node":99}|]
 
       it "returns the new error if header X-Garg-Error-Scheme: new is passed" $ \((_testEnv, port), app) -> do
         withApplication app $ do

test/Test/Utils.hs

@@ -13,14 +13,14 @@ import Language.Haskell.TH.Quote
 import Network.HTTP.Types
 import Network.Wai.Test
 import Prelude
+import qualified Data.Aeson as JSON
+import qualified Data.Aeson.KeyMap as KM
+import qualified Data.ByteString.Char8 as B
 import Test.Hspec.Expectations
 import Test.Hspec.Wai
 import Test.Hspec.Wai.JSON
 import Test.Hspec.Wai.Matcher
 import Test.Tasty.HUnit
-import qualified Data.Aeson as JSON
-import qualified Data.ByteString.Char8 as B
-import qualified Data.HashMap.Strict as HM
 
 -- | Marks the input 'Assertion' as pending, by ignoring any exception
 -- thrown by it.
@@ -87,5 +87,5 @@ containsJSON expected = MatchBody matcher
 
     isSubsetOf :: Value -> Value -> Bool
     isSubsetOf (Object sub) (Object sup) =
-      all (\(key, value) -> HM.lookup key sup == Just value) (HM.toList sub)
+      all (\(key, value) -> KM.lookup key sup == Just value) (KM.toList sub)
     isSubsetOf x y = x == y

test/Test/Utils/Jobs.hs

@@ -254,7 +254,7 @@ withJob :: Env
         -> IO (SJ.JobStatus 'SJ.Safe JobLog)
 withJob env f = runMyDummyMonad env $ MyDummyMonad $
   -- the job type doesn't matter in our tests, we use a random one, as long as it's of type 'GargJob'.
-  newJob @_ @BackendInternalError mkJobHandle (pure env) RecomputeGraphJob (\_ hdl input ->
+  newJob @_ mkJobHandle (pure env) RecomputeGraphJob (\_ hdl input ->
     runMyDummyMonad env $ (Right <$> (f hdl input >> getLatestJobStatus hdl))) (SJ.JobInput () Nothing)
 
 withJob_ :: Env

test/drivers/hspec/Main.hs

@@ -2,7 +2,7 @@
 
 module Main where
 
-import Gargantext.Prelude
+import Gargantext.Prelude hiding (isInfixOf)
 
 import Control.Monad
 import Data.Text (isInfixOf)