Merge branch 'testing' into stable

.gitlab-ci.yml

@@ -37,7 +37,7 @@ cabal:
       - .cabal/
     policy: pull-push
   script:
-    - nix-shell --run "./bin/update-project-dependencies $CABAL_STORE_DIR && cabal --store-dir=$CABAL_STORE_DIR v2-build --flags 'test-crypto no-phylo-debug-logs' --ghc-options='-O0 -fclear-plugins'"
+    - nix-shell --run "./bin/update-project-dependencies $CABAL_STORE_DIR && cabal --store-dir=$CABAL_STORE_DIR v2-build all --flags 'test-crypto no-phylo-debug-logs' --ghc-options='-O0 -fclear-plugins'"
   allow_failure: false
 
 bench:

CHANGELOG.md

+## Version 0.0.7.1.11
+
+* [BACK][SECURITY][Allow the microservices proxy to be disabled or enabled by configuration settings (#369)](https://gitlab.iscpif.fr/gargantext/haskell-gargantext/issues/369)
+
+## Version 0.0.7.1.10
+
+* [BACK][FIX][Improving message error from the TSV import (#361)](https://gitlab.iscpif.fr/gargantext/haskell-gargantext/issues/361)
+* [BACK][FIX][Creation of corpus from HAL's API crash (#366)](https://gitlab.iscpif.fr/gargantext/haskell-gargantext/issues/366)
+* [BACK][FIX][[Documentation] Improve README (#365)](https://gitlab.iscpif.fr/gargantext/haskell-gargantext/issues/365)
+
+## Version 0.0.7.1.9
+
+* [BACK][FIX][Write Frame microservice proxy improvements (#364)](https://gitlab.iscpif.fr/gargantext/haskell-gargantext/issues/364)
+* [BACK][FIX][Integrate `servant-routes` in the codebase (#350)](https://gitlab.iscpif.fr/gargantext/haskell-gargantext/issues/350)
+* [BACK][FIX][[Documentation] Improve README (#365)](https://gitlab.iscpif.fr/gargantext/haskell-gargantext/issues/365)
+* [BACK][FIX][Improving message error from the TSV import (#361)](https://gitlab.iscpif.fr/gargantext/haskell-gargantext/issues/361)
+
+## Version 0.0.7.1.8
+
+* [BACK][FEAT][[Graph explorer] Search and associated documents (#262)](https://gitlab.iscpif.fr/gargantext/purescript-gargantext/issues/262) (Backend Part).
+
+## Version 0.0.7.1.7.4
+
+* [FRONT][FEAT][[Graph explorer] Search and associated documents (#262)](https://gitlab.iscpif.fr/gargantext/purescript-gargantext/issues/262)
+* [FRONT][FEAT][Info list in top bar: use purescript only (#242)](https://gitlab.iscpif.fr/gargantext/purescript-gargantext/issues/242)
+* [BACK][DOC][[DOCS]: Describe frontend's build step (#363)](https://gitlab.iscpif.fr/gargantext/haskell-gargantext/issues/363)
+* [BACK][INSTALL] Removing unused docker dependency
+
+## Version 0.0.7.1.7.3
+
+* [BACK][ADM][Consider moving `GargConfig` & co outside of `gargantext-prelude` (#356)](https://gitlab.iscpif.fr/gargantext/haskell-gargantext/issues/356)
+* [BACK][DOC] Readme updated
+
+## Version 0.0.7.1.7.2
+
+* [FEAT][Calc] Enabling Node calc url sharing
+* [BACK][REFACT][We have too many executables (#355)](https://gitlab.iscpif.fr/gargantext/haskell-gargantext/issues/355)
+
+## Version 0.0.7.1.7.1
+
+* [CI-TESTS][OK]
+
+## Version 0.0.7.1.7
+
+* [BACK][SECURITU] Node Notes Right managements
+
 ## Version 0.0.7.1.6.5
 
 * [BACK][FIX] TSV/CSV hot fix

CONTRIBUTING.md

-# Contributing
-
-## Code contribution
-
-We use Git to share and merge our code.
-
-## Style
-
-We are using the common Haskell Style:
-https://github.com/tibbe/haskell-style-guide/blob/master/haskell-style.md
-
-## Code Of Conduct
-
-Be constructive as sharing our code of conduct
-
-## Chat with us
-
-We are on IRC:  [irc.oftc.net, channel #gargantext](ircs://irc.oftc.net:6697/#gargantext)
-
-You can join via Matrix, just search for: #_oftc_#gargantext:matrix.org
-
-You can also join via XMPP: <xmpp://#gargantext%irc.oftc.net@irc.jabberfr.org?join>

DEVELOPER_GUIDELINES.md

@@ -39,6 +39,7 @@ all developers about how to:
 
 The rest of the document try to answer all those questions.
 
+
 ## Glossary
 
 - GIT: _Git_ is a distributed version control system
@@ -57,7 +58,29 @@ The rest of the document try to answer all those questions.
 
 The following is a non-exhaustive list of the development guidelines.
 
-### Main working Branches
+### Style
+
+When we code, we try to use the [common Haskell Style guide](https://github.com/tibbe/haskell-style-guide/blob/master/haskell-style.md).
+
+1. For new files, use the referenced style guide;
+2. For older files, which might have been written using a different code style, try to respect whichever style guide was used to write the file (to ensure consistency and minimise unwanted changes);
+3. Resist the urge of making style modifications mixed to general refactoring; rather separate those into independent commits, so that they are easy to revert if unwanted / not needed
+
+### Code Of Conduct
+
+Please be constructive as sharing our [code of conduct](https://gitlab.iscpif.fr/gargantext/main/blob/master/CODE_OF_CONDUCT.md).
+
+### Chat with us !
+
+We are on IRC:  [irc.oftc.net, channel #gargantext](ircs://irc.oftc.net:6697/#gargantext)
+
+You can join via Matrix, just search for: #_oftc_#gargantext:matrix.org
+
+You can also join via XMPP: <xmpp://#gargantext%irc.oftc.net@irc.jabberfr.org?join>
+
+## Git Collaboration Guidelines
+
+### Git Main working Branches
 
 3 main branches are used in the distributed version control system (Git) of GarganText:
 - _dev_ branch for latest development

bin/gargantext-admin/Main.hs

-{-|
-Module      : Main.hs
-Description : Gargantext Admin tools
-Copyright   : (c) CNRS, 2017-Present
-License     : AGPL + CECILL v3
-Maintainer  : team@gargantext.org
-Stability   : experimental
-Portability : POSIX
-
-
-
- -}
-
-{-# LANGUAGE Strict            #-}
-
-module Main where
-
-import Gargantext.API.Dev (withDevEnv, runCmdDev)
-import Gargantext.API.Errors.Types
-import Gargantext.Database.Action.User.New (newUsers)
-import Gargantext.Database.Admin.Types.Node
-import Gargantext.Database.Prelude (Cmd'')
-import Gargantext.Prelude
-import Gargantext.API.Admin.EnvTypes (DevEnv)
-import qualified Data.List.NonEmpty as NE
-
-main :: IO ()
-main = do
-  (iniPath:mails) <- getArgs
-
-  withDevEnv iniPath $ \env -> do
-    x <- runCmdDev env ((newUsers $ NE.map cs (NE.fromList mails)) :: Cmd'' DevEnv BackendInternalError (NonEmpty UserId))
-    putStrLn (show x :: Text)
-  pure ()

bin/gargantext-cli/CLI/Admin.hs

+
+module CLI.Admin (
+    adminCLI
+  , adminCmd
+  ) where
+
+import CLI.Parsers
+import CLI.Types
+import Data.List.NonEmpty qualified as NE
+import Data.Text qualified as T
+import Gargantext.API.Admin.EnvTypes
+import Gargantext.API.Dev
+import Gargantext.API.Errors
+import Gargantext.Core.Types
+import Gargantext.Database.Action.User.New
+import Gargantext.Database.Prelude
+import Gargantext.Prelude
+import Options.Applicative
+import Prelude (String)
+
+adminCLI :: AdminArgs -> IO ()
+adminCLI (AdminArgs iniPath settingsPath mails) = do
+  withDevEnv iniPath settingsPath $ \env -> do
+    x <- runCmdDev env ((newUsers $ NE.map cs (NE.fromList mails)) :: Cmd'' DevEnv BackendInternalError (NonEmpty UserId))
+    putStrLn (show x :: Text)
+
+adminCmd :: HasCallStack => Mod CommandFields CLI
+adminCmd = command "admin" (info (helper <*> fmap CLISub admin_p) (progDesc "Create users."))
+
+admin_p :: Parser CLICmd
+admin_p = fmap CCMD_admin $ AdminArgs
+  <$> ini_p <*> settings_p
+  <*> ( option (maybeReader emails_p) ( long "emails"
+                      <> metavar "email1,email2,..."
+                      <> help "A comma-separated list of emails."
+                      ) )
+
+emails_p :: String -> Maybe [String]
+emails_p s = case T.splitOn "," (T.pack s) of
+  [] -> Nothing
+  xs -> pure $ map T.unpack xs

bin/gargantext-cli/CleanCsvCorpus.hs → bin/gargantext-cli/CLI/CleanCsvCorpus.hs

@@ -12,7 +12,7 @@ compress the contexts around the main terms of the query.
 -}
 
 
-module CleanCsvCorpus  where
+module CLI.CleanCsvCorpus  where
 
 import Data.SearchEngine qualified as S
 import Data.Set qualified as S

bin/gargantext-golden-file-diff/Main.hs → bin/gargantext-cli/CLI/FileDiff.hs

 
-module Main where
+module CLI.FileDiff where
 
-import Prelude
+import CLI.Types
+import Data.List qualified as L
+import Data.Text qualified as T
+import Data.Text.IO qualified as TIO
 import Data.TreeDiff.Class
 import Data.TreeDiff.Pretty
-import qualified Data.Text as T
-import qualified Data.Text.IO as TIO
-import System.Environment (getArgs)
-import System.Exit (exitFailure)
-import Control.Monad (unless)
-import qualified Data.List as L
+import Gargantext.Prelude (HasCallStack, unless, exitFailure)
+import Options.Applicative
+import Prelude
 
 -- | Renders in a pretty way the content of two golden files. The
 -- first file should contain the expected output, the second the
 -- actual data generated by the test suite.
-main :: IO ()
-main = do
-  (refPath:newPath:_) <- getArgs
+fileDiffCLI :: GoldenFileDiffArgs -> IO ()
+fileDiffCLI (GoldenFileDiffArgs refPath newPath) = do
   ref <- T.lines <$> TIO.readFile refPath
   new <- T.lines <$> TIO.readFile newPath
 
@@ -25,3 +24,17 @@ main = do
   unless (L.null differences) $ do
     putStrLn $ show $ ansiWlEditExpr $ ediff' (map fst differences) (map snd differences)
     exitFailure
+
+fileDiffCmd :: HasCallStack => Mod CommandFields CLI
+fileDiffCmd = command "golden-file-diff" (info (helper <*> fmap CLISub filediff_p) (progDesc "Compare the output of two golden files."))
+
+filediff_p :: Parser CLICmd
+filediff_p = fmap CCMD_golden_file_diff $ GoldenFileDiffArgs
+  <$> ( strOption ( long "expected"
+                    <> metavar "FILEPATH"
+                    <> help "Path to the file containing the expected output."
+                    ) )
+  <*> ( strOption ( long "actual"
+                    <> metavar "FILEPATH"
+                    <> help "Path to the file containing the actual output."
+                    ) )

bin/gargantext-cli/CLI/FilterTermsAndCooc.hs

+
+module CLI.FilterTermsAndCooc (
+    filterTermsAndCoocCmd
+  , filterTermsAndCoocCLI
+
+  -- * Testing functions
+  , testCorpus
+  , testTermList
+  ) where
+
+import CLI.Types
+import Control.Concurrent.Async as CCA (mapConcurrently)
+import Data.Aeson ( encode )
+import Data.Map.Strict qualified as DM
+import Data.Text (pack)
+import Data.Text qualified as DT
+import Data.Text.Lazy qualified as DTL
+import Data.Text.Lazy.Encoding qualified as TLE
+import Data.Tuple.Extra (both)
+import Data.Vector qualified as DV
+import GHC.Generics
+import Gargantext.Core.Text.Context (TermList)
+import Gargantext.Core.Text.Corpus.Parsers.TSV (readTSVFile, tsv_title, tsv_abstract, tsv_publication_year, fromMIntOrDec, defaultYear)
+import Gargantext.Core.Text.List.Formats.TSV (tsvMapTermList)
+import Gargantext.Core.Text.Metrics.Count (coocOnContexts, Coocs)
+import Gargantext.Core.Text.Terms.WithList ( Patterns, buildPatterns, extractTermsWithList )
+import Gargantext.Prelude
+import Options.Applicative
+
+------------------------------------------------------------------------
+-- OUTPUT format
+
+data CoocByYear = CoocByYear { year         :: Int
+                             , nbContexts   :: NbContexts
+                             , coocurrences :: Map (Text, Text) Coocs
+                             } deriving (Show, Generic)
+
+data CoocByYears = CoocByYears { years :: [CoocByYear] }
+  deriving (Show, Generic)
+
+type NbContexts = Int
+
+instance ToJSON CoocByYear
+instance ToJSON CoocByYears
+------------------------------------------------------------------------
+
+filterTermsAndCoocCLI :: CorpusFile -> TermListFile -> OutputFile -> IO ()
+filterTermsAndCoocCLI (CorpusFile corpusFile) (TermListFile termListFile) (OutputFile outputFile) = do
+  --corpus :: IO (DM.IntMap [[Text]])
+  eCorpusFile <- readTSVFile corpusFile
+  case eCorpusFile of
+    Right cf -> do
+      let corpus = DM.fromListWith (<>)
+                   . DV.toList
+                   . DV.map (\n -> (fromMIntOrDec defaultYear $ tsv_publication_year n, [(tsv_title n) <> " " <> (tsv_abstract n)]))
+                   . snd $ cf
+
+      -- termListMap :: [Text]
+      termList <- tsvMapTermList termListFile
+
+      putText $ show $ length termList
+
+      let patterns = buildPatterns termList
+
+      -- r <- mapConcurrentlyChunked (filterTermsAndCooc patterns) (DM.toList corpus)
+      r <-  mapConcurrently (filterTermsAndCooc patterns) (DM.toList corpus)
+      writeFile outputFile $ DTL.toStrict $ TLE.decodeUtf8 $ encode (CoocByYears r)
+    Left e -> panicTrace $ "Error: " <> e
+
+
+
+
+filterTermsAndCooc
+  :: Patterns
+     -> (Int, [Text])
+     -> IO CoocByYear -- (Int, (Map (Text, Text) Coocs))
+filterTermsAndCooc patterns (year, ts) = do
+  logWork "start"
+  r <- coocOnContexts identity <$> mapM (\x -> {-log "work" >>-} terms' patterns x) ts
+  logWork "stop"
+  pure $ CoocByYear year (length ts) (DM.mapKeys (both DT.unwords) r)
+  where
+
+    logWork m = do
+      tid    <- myThreadId
+      (p, _) <- threadCapability tid
+      putText . unwords $
+        ["filterTermsAndCooc:", m, show year, "on proc", show p]
+
+--terms' :: Patterns -> Text -> Corpus [[Text]]
+terms' :: Applicative f => Patterns -> Text -> f [[Text]]
+terms' pats txt = pure $ concat $ extractTermsWithList pats txt
+
+
+-- | TODO Minimal Example
+--testCooc = do
+--  let patterns = buildPatterns testTermList
+--  mapM (\x -> {-log "work" >>-} terms' patterns x) $ catMaybes $ map (head . snd) testCorpus
+--  --mapConcurrently (filterTermsAndCooc patterns) testCorpus
+
+
+testCorpus :: [(Int, [Text])]
+testCorpus = [ (1998, [pack "The beees"])
+             , (1999, [ pack "The bees and the flowers"
+                      --, pack "The bees and the flowers"
+                      ])
+             ]
+
+testTermList :: TermList
+testTermList = [ ([pack "bee"], [[pack "bees"]])
+               , ([pack "flower"], [[pack "flowers"]])
+               ]
+
+--
+-- CLI API
+--
+
+filterTermsAndCoocCmd :: HasCallStack => Mod CommandFields CLI
+filterTermsAndCoocCmd = command "filter-terms" (info (helper <*> fmap CLISub filterTerms) (progDesc "Filter Terms and Cooc."))
+
+filterTerms :: Parser CLICmd
+filterTerms = CCMD_filter_terms_and_cooc
+  <$> (option str (long "corpus-file" <> metavar "FILE"))
+  <*> (option str (long "terms-list-file" <> metavar "FILE"))
+  <*> (option str (long "output-file" <> metavar "FILE"))

bin/gargantext-import/Main.hs → bin/gargantext-cli/CLI/Import.hs

 {-|
-Module      : Main.hs
+Module      : Import.hs
 Description : Gargantext Import Corpus
 Copyright   : (c) CNRS, 2017-Present
 License     : AGPL + CECILL v3
@@ -12,10 +12,14 @@ Import a corpus binary.
  -}
 
 {-# LANGUAGE Strict            #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE LambdaCase #-}
 
-module Main where
+module CLI.Import where
 
-import Data.Text qualified as Text
+import CLI.Parsers
+import CLI.Types
 import Gargantext.API.Admin.EnvTypes (DevEnv(..), DevJobHandle(..))
 import Gargantext.API.Dev (withDevEnv, runCmdGargDev)
 import Gargantext.API.Errors.Types ( BackendInternalError )
@@ -23,66 +27,63 @@ import Gargantext.API.Node () -- instances
 import Gargantext.Core (Lang(..))
 import Gargantext.Core.Text.Corpus.Parsers (FileFormat(..), FileType(..))
 import Gargantext.Core.Types.Individu (User(..))
-import Gargantext.Core.Types.Query (Limit)
+import Gargantext.Core.Types.Query
 import Gargantext.Database.Action.Flow (flowCorpusFile, flowAnnuaire, TermType(..))
 import Gargantext.Database.Action.Flow.Types (FlowCmdM)
 import Gargantext.Database.Admin.Types.Node (CorpusId)
 import Gargantext.Database.Query.Tree.Root (MkCorpusUser(MkCorpusUserNormalCorpusName))
 import Gargantext.Prelude
 import Gargantext.Utils.Jobs.Monad ( MonadJobStatus, JobHandle )
+import Options.Applicative
+import Prelude (String)
+import qualified Data.Text as T
 
 
-main :: IO ()
-main = do
-  [fun, user, name, iniPath, limit, corpusPath] <- getArgs
-
-  --{-
-
+importCLI :: ImportArgs -> IO ()
+importCLI (ImportArgs fun user name iniPath settingsPath limit corpusPath) = do
   let
-    --tt = (Unsupervised EN 6 0 Nothing)
-    tt = (Multi EN)
-    format = TsvGargV3 -- TsvHal --WOS
-    limit' = case (readMaybe limit :: Maybe Limit) of
-      Nothing -> panicTrace $ "Cannot read limit: " <> (Text.pack limit)
-      Just l  -> l
+    tt     = Multi EN
+    format = TsvGargV3
     corpus :: forall m. (FlowCmdM DevEnv BackendInternalError m, MonadJobStatus m, JobHandle m ~ DevJobHandle) => m CorpusId
     mkCorpusUser = MkCorpusUserNormalCorpusName (UserName $ cs user) (cs name :: Text)
-    corpus = flowCorpusFile mkCorpusUser limit' tt  format Plain corpusPath Nothing DevJobHandle
+    corpus = flowCorpusFile mkCorpusUser limit tt  format Plain corpusPath Nothing DevJobHandle
 
     corpusTsvHal :: forall m. (FlowCmdM DevEnv BackendInternalError m, MonadJobStatus m, JobHandle m ~ DevJobHandle) => m CorpusId
-    corpusTsvHal = flowCorpusFile mkCorpusUser limit' tt TsvHal Plain corpusPath Nothing DevJobHandle
+    corpusTsvHal = flowCorpusFile mkCorpusUser limit tt TsvHal Plain corpusPath Nothing DevJobHandle
 
     annuaire :: forall m. (FlowCmdM DevEnv BackendInternalError m, MonadJobStatus m, JobHandle m ~ DevJobHandle) => m CorpusId
     annuaire = flowAnnuaire (MkCorpusUserNormalCorpusName (UserName $ cs user) "Annuaire") (Multi EN) corpusPath DevJobHandle
 
-  {-
-  let debatCorpus :: forall m. FlowCmdM DevEnv BackendInternalError m => m CorpusId
-      debatCorpus = do
-        docs <- liftIO ( splitEvery 500
-                       <$> take (read limit :: Int)
-                       <$> readFile corpusPath
-                       :: IO [[GrandDebatReference ]]
-                       )
-        flowCorpus (Text.pack user) (Text.pack name) (Multi FR) (map (map toHyperdataDocument) docs)
-  --}
+  withDevEnv iniPath settingsPath $ \env -> do
+    void $ case fun of
+      IF_corpus
+        -> runCmdGargDev env corpus
+      IF_corpusTsvHal
+        -> runCmdGargDev env corpusTsvHal
+      IF_annuaire
+        -> runCmdGargDev env annuaire
 
-  withDevEnv iniPath $ \env -> do
-    _ <- if fun == "corpus"
-          then runCmdGargDev env corpus
-          else pure 0 --(cs "false")
+importCmd :: HasCallStack => Mod CommandFields CLI
+importCmd = command "import" (info (helper <*> fmap CLISub import_p) (progDesc "Import CLI."))
 
-    _ <- if fun == "corpusTsvHal"
-          then runCmdGargDev env corpusTsvHal
-          else pure 0 --(cs "false")
+renderImportFunction :: ImportFunction -> T.Text
+renderImportFunction = T.drop 3 . T.pack . show
 
-    _ <- if fun == "annuaire"
-            then runCmdGargDev env annuaire
-            else pure 0
-    {-
-    _ <- if corpusType == "csv"
-            then runCmdDev env csvCorpus
-            else if corpusType == "debat"
-              then runCmdDev env debatCorpus
-              else panic "corpusType unknown: try \"csv\" or \"debat\""
-    -}
-    pure ()
+import_p :: Parser CLICmd
+import_p = fmap CCMD_import $ ImportArgs
+  <$> ( option (eitherReader function_p) ( long "function"
+                    <> help ("The function to use, one between: " <> (T.unpack $ T.intercalate "," $ map renderImportFunction [minBound .. maxBound]))
+                    ) )
+  <*> ( option str ( long "user") )
+  <*> ( option str ( long "name") )
+  <*> ini_p
+  <*> settings_p
+  <*> (fmap Limit ( option auto ( long "limit" <> metavar "INT" <> help "The limit for the query") ))
+  <*> ( option str ( long "corpus-path" <> help "Path to corpus file") )
+
+function_p :: String -> Either String ImportFunction
+function_p = \case
+  "corpus"       -> Right IF_corpus
+  "corpusTsvHal" -> Right IF_corpusTsvHal
+  "annuaire"     -> Right IF_annuaire
+  xs             -> Left $ "Unrecognised function: " <> xs

bin/gargantext-init/Main.hs → bin/gargantext-cli/CLI/Init.hs

 {-|
-Module      : Main.hs
-Description : Gargantext Import Corpus
+Module      : Init.hs
+Description : Gargantext Init Script
 Copyright   : (c) CNRS, 2017-Present
 License     : AGPL + CECILL v3
 Maintainer  : team@gargantext.org
 Stability   : experimental
 Portability : POSIX
 
-Import a corpus binary.
+Initialise the Gargantext dataset.
 
  -}
 
 {-# LANGUAGE Strict            #-}
 
-module Main where
+module CLI.Init where
 
+import CLI.Parsers
+import CLI.Types
 import Data.List.NonEmpty qualified as NE
+import Gargantext.API.Admin.Settings
+import Gargantext.API.Admin.Types
 import Gargantext.API.Dev (withDevEnv, runCmdDev)
 import Gargantext.API.Errors.Types
 import Gargantext.API.Node () -- instances only
+import Gargantext.Core.Config (GargConfig(..), readConfig)
 import Gargantext.Core.Types.Individu (User(..), arbitraryNewUsers, NewUser(..), arbitraryUsername, GargPassword(..))
 import Gargantext.Database.Action.Flow (getOrMkRoot, getOrMkRootWithCorpus)
 import Gargantext.Database.Admin.Trigger.Init (initFirstTriggers, initLastTriggers)
 import Gargantext.Database.Admin.Types.Hyperdata (HyperdataCorpus)
 import Gargantext.Database.Admin.Types.Node
-import Gargantext.Database.Prelude (Cmd, DBCmd)
+import Gargantext.Database.Prelude (DBCmd')
+import Gargantext.Database.Prelude (DBCmd)
 import Gargantext.Database.Query.Table.Node (getOrMkList)
 import Gargantext.Database.Query.Table.User (insertNewUsers, )
 import Gargantext.Database.Query.Tree.Root (MkCorpusUser(MkCorpusUserMaster))
 import Gargantext.Prelude
-import Gargantext.Prelude.Config (GargConfig(..), readConfig)
+import Options.Applicative
 
 
-main :: IO ()
-main = do
-  params@[iniPath] <- getArgs
-
-  _ <- if length params /= 1
-      then panicTrace "USAGE: ./gargantext-init gargantext.ini"
-      else pure ()
-
+initCLI :: InitArgs -> IO ()
+initCLI (InitArgs iniPath settingsPath) = do
   putStrLn ("Enter master user (gargantua) _password_ :" :: Text)
   password  <- getLine
 
   putStrLn ("Enter master user (gargantua) _email_ :" :: Text)
   email     <- getLine
 
-  cfg       <- readConfig         iniPath
+  cfg       <- readConfig         (_IniFile iniPath)
   let secret = _gc_secretkey cfg
 
-  let createUsers :: Cmd BackendInternalError Int64
+  let createUsers :: forall env. HasSettings env => DBCmd' env BackendInternalError Int64
       createUsers = insertNewUsers (NewUser "gargantua" (cs email) (GargPassword $ cs password)
                                    NE.:| arbitraryNewUsers
                                    )
 
   let
-    mkRoots :: Cmd BackendInternalError [(UserId, RootId)]
+    mkRoots :: forall env. HasSettings env => DBCmd' env BackendInternalError [(UserId, RootId)]
     mkRoots = mapM getOrMkRoot $ map UserName ("gargantua" : arbitraryUsername)
     -- TODO create all users roots
 
   let
-    initMaster :: Cmd BackendInternalError (UserId, RootId, CorpusId, ListId)
+    initMaster :: forall env. HasSettings env => DBCmd' env BackendInternalError (UserId, RootId, CorpusId, ListId)
     initMaster = do
       (masterUserId, masterRootId, masterCorpusId)
                   <- getOrMkRootWithCorpus MkCorpusUserMaster
@@ -69,10 +69,16 @@ main = do
       _triggers    <- initLastTriggers masterListId
       pure (masterUserId, masterRootId, masterCorpusId, masterListId)
 
-  withDevEnv iniPath $ \env -> do
+  withDevEnv iniPath settingsPath $ \env -> do
     _ <- runCmdDev env (initFirstTriggers secret :: DBCmd BackendInternalError [Int64])
     _ <- runCmdDev env createUsers
     x <- runCmdDev env initMaster
     _ <- runCmdDev env mkRoots
     putStrLn (show x :: Text)
-    pure ()
+
+initCmd :: HasCallStack => Mod CommandFields CLI
+initCmd = command "init" (info (helper <*> fmap CLISub init_p) (progDesc "Initialise this Gargantext instance."))
+
+init_p :: Parser CLICmd
+init_p = fmap CCMD_init $ InitArgs
+  <$> ini_p <*> settings_p

bin/gargantext-invitations/Main.hs → bin/gargantext-cli/CLI/Invitations.hs

 {-|
-Module      : Main.hs
+Module      : Invitations.hs
 Description : GarganText Mailing Invitations
 Copyright   : (c) CNRS, 2017-Present
 License     : AGPL + CECILL v3
@@ -12,34 +12,51 @@ Portability : POSIX
 
 {-# LANGUAGE Strict            #-}
 
-module Main where
+module CLI.Invitations where
 
+import CLI.Parsers
+import CLI.Types
+import Gargantext.API.Admin.Settings
+import Gargantext.API.Admin.Types
 import Gargantext.API.Dev (withDevEnv, runCmdDev)
-import Gargantext.API.Node () -- instances only
 import Gargantext.API.Errors.Types
+import Gargantext.API.Node () -- instances only
+import Gargantext.API.Node.Share qualified as Share
+import Gargantext.API.Node.Share.Types qualified as Share
+import Gargantext.Core.Config (readConfig)
 import Gargantext.Core.NLP (HasNLPServer)
+import Gargantext.Core.Types
 import Gargantext.Core.Types.Individu (User(..))
-import Gargantext.Database.Admin.Types.Node
 import Gargantext.Database.Prelude (CmdRandom)
 import Gargantext.Prelude
-import Gargantext.Prelude.Config (readConfig)
-import Prelude (read)
-import Gargantext.API.Node.Share.Types qualified as Share
-import Gargantext.API.Node.Share qualified as Share
-
-main :: IO ()
-main = do
-  params@[iniPath,user,node_id,email] <- getArgs
-
-  _ <- if length params /= 4
-      then panicTrace "USAGE: ./gargantext-init gargantext.ini username node_id student@university.edu"
-      else pure ()
-
-  _cfg       <- readConfig         iniPath
-
-  let invite :: (CmdRandom env BackendInternalError m, HasNLPServer env) => m Int
-      invite = Share.api (UserName $ cs user) (UnsafeMkNodeId $ (read node_id :: Int)) (Share.ShareTeamParams $ cs email)
-
-  withDevEnv iniPath $ \env -> do
-    _ <- runCmdDev env invite
-    pure ()
+import Options.Applicative
+import Prelude (String)
+
+invitationsCLI :: InvitationsArgs -> IO ()
+invitationsCLI (InvitationsArgs iniPath settingsPath user node_id email) = do
+  _cfg       <- readConfig         (_IniFile iniPath)
+
+  let invite :: (HasSettings env, CmdRandom env BackendInternalError m, HasNLPServer env) => m Int
+      invite = Share.api (UserName $ cs user) node_id (Share.ShareTeamParams $ cs email)
+
+  withDevEnv iniPath settingsPath $ \env -> do
+    void $ runCmdDev env invite
+
+invitationsCmd :: HasCallStack => Mod CommandFields CLI
+invitationsCmd = command "invitations" (info (helper <*> fmap CLISub invitations_p) (progDesc "Mailing invitations."))
+
+invitations_p :: Parser CLICmd
+invitations_p = fmap CCMD_invitations $ InvitationsArgs
+  <$> ini_p
+  <*> settings_p
+  <*> ( strOption ( long "user" ) )
+  <*> ( option (eitherReader node_p)  ( long "node-id" <> metavar "POSITIVE-INT" <> help "The node ID.") )
+  <*> ( strOption ( long "email" <> help "The email address.") )
+
+node_p :: String -> Either String NodeId
+node_p i = case readMaybe i of
+  Nothing -> Left $ i <> " is not a valid integer."
+  Just xs
+    | xs < 0 -> Left $ "The node id needs to be a positive integer."
+    | otherwise
+    -> Right $ UnsafeMkNodeId xs

bin/gargantext-db-obfuscation/Main.hs → bin/gargantext-cli/CLI/ObfuscateDB.hs

@@ -28,8 +28,10 @@ https://stackoverflow.com/questions/876522/creating-a-copy-of-a-database-in-post
 {-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE Strict            #-}
 
-module Main where
-
+module CLI.ObfuscateDB (
+    obfuscateDB
+  , obfuscateDBCmd
+  ) where
 
 import Data.Text qualified as T
 import Database.PostgreSQL.Simple qualified as PSQL
@@ -37,23 +39,16 @@ import Database.PostgreSQL.Simple.SqlQQ (sql)
 import Gargantext.Core (toDBid)
 import Gargantext.Database.Admin.Config ()
 import Gargantext.Database.Admin.Types.Node (NodeType(..))
-import Gargantext.Prelude hiding (option)
+import Gargantext.Prelude
 import Gargantext.Prelude.Database (runPGSExecute, runPGSQuery)
-import Options.Applicative.Simple
-
-
+import CLI.Types
+import Options.Applicative
 
-data Args = Args {
-    dbHost     :: Text
-  , dbPort     :: Int
-  , dbName     :: Text
-  , dbUser     :: Text
-  , dbPassword :: Text
-  } deriving (Show, Eq)
+obfuscateDBCmd :: HasCallStack => Mod CommandFields CLI
+obfuscateDBCmd = command "obfuscate-db" (info (helper <*> fmap CLISub obfuscateDB_p) (progDesc "Obfuscate a cloned Gargantext DB."))
 
-
-args :: Parser Args
-args = Args
+obfuscateDB_p :: Parser CLICmd
+obfuscateDB_p = fmap CCMD_obfuscate_db $ ObfuscateDBArgs
   <$> ( strOption ( long "db-host"
                     <> metavar "db-host"
                     <> help "Location of the DB server"
@@ -72,16 +67,8 @@ args = Args
                     <> metavar "db-password"
                     <> value "" ))
 
-
-main :: IO ()
-main = do
-  (opts, ()) <-
-    simpleOptions "0.0.1"
-                  "gargantext DB obfuscation"
-                  "Obfuscates a cloned Gargantext DB"
-                  args
-                  empty
-
+obfuscateDB :: ObfuscateDBArgs -> IO ()
+obfuscateDB opts = do
   putText $ show opts
 
   let ci = PSQL.ConnectInfo { connectHost     = T.unpack $ dbHost opts

bin/gargantext-cli/CLI/Parsers.hs

+
+{-| Common parsers for the CLI. -}
+
+module CLI.Parsers where
+
+import Prelude
+import Gargantext.API.Admin.Settings
+import Options.Applicative
+
+ini_p :: Parser IniFile
+ini_p = maybe (IniFile "gargantext.ini") IniFile <$>
+  optional ( strOption ( long "ini-path"
+                    <> metavar "FILEPATH"
+                    <> help "Location of the .ini file"
+                    ) )
+
+settings_p :: Parser SettingsFile
+settings_p = maybe (SettingsFile "gargantext-settings.toml") SettingsFile <$>
+  optional ( strOption ( long "settings-path"
+                    <> metavar "FILEPATH"
+                    <> help "Location of the gargantext-settings toml file"
+                    ) )

bin/gargantext-cli/CLI/Phylo.hs

+{-|
+Module      : Phylo.hs
+Description : Gargantext starter binary with Adaptative Phylo
+Copyright   : (c) CNRS, 2017-Present
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+
+Adaptative Phylo binaries
+ -}
+
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TypeOperators      #-}
+{-# LANGUAGE Strict             #-}
+
+module CLI.Phylo where
+
+import CLI.Phylo.Common
+import CLI.Types
+import Data.Aeson (eitherDecodeFileStrict')
+import Data.List  (nub)
+import Data.Text qualified as T
+import GHC.IO.Encoding
+import Gargantext.Core.Viz.Phylo
+import Gargantext.Core.Viz.Phylo.API.Tools
+import Gargantext.Core.Viz.Phylo.PhyloExport (toPhyloExport, dotToFile)
+import Gargantext.Core.Viz.Phylo.PhyloMaker  (toPhylo, toPhyloWithoutLink)
+import Gargantext.Core.Viz.Phylo.PhyloTools  (printIOMsg, printIOComment, setConfig)
+import Gargantext.Prelude hiding (hash, replace)
+import Options.Applicative
+import System.Directory (doesFileExist)
+
+phyloCLI :: PhyloArgs -> IO ()
+phyloCLI (PhyloArgs configPath) = do
+  setLocaleEncoding utf8
+  config_e <- eitherDecodeFileStrict' configPath
+  case config_e of
+    Left err -> panicTrace $ T.pack err
+    Right config -> do
+      currentLocale <- getLocaleEncoding
+      printIOMsg $ "Machine locale: " <> show currentLocale
+      printIOMsg "Starting the reconstruction"
+      printIOMsg "Parse the corpus"
+      mapList <-  fileToList (listParser config) (listPath config)
+
+      corpus  <- if (defaultMode config)
+                  then fileToDocsDefault (corpusParser config) (corpusPath config) [Year 3 1 5,Month 3 1 5,Week 4 2 5] mapList
+                  else fileToDocsAdvanced (corpusParser config) (corpusPath config) (timeUnit config)  mapList
+
+      printIOComment (show (length corpus) <> " parsed docs from the corpus")
+
+      printIOComment (show (length $ nub $ concat $ map text corpus) <> " Size ngs_coterms")
+
+      printIOComment (show (length mapList) <> " Size ngs_terms List Map Ngrams")
+
+      printIOMsg "Reconstruct the phylo"
+
+      -- check the existing backup files
+
+      let backupPhyloWithoutLink = (outputPath config) <> "backupPhyloWithoutLink_" <> (configToSha BackupPhyloWithoutLink config) <> ".json"
+      let backupPhylo = (outputPath config) <> "backupPhylo_"   <> (configToSha BackupPhylo config) <> ".json"
+
+      phyloWithoutLinkExists <- doesFileExist backupPhyloWithoutLink
+      phyloExists   <- doesFileExist backupPhylo
+
+      -- reconstruct the phylo
+
+      phylo <- if phyloExists
+                  then do
+                    printIOMsg "Reconstruct the phylo from an existing file"
+                    readPhylo backupPhylo
+                  else do
+                    if phyloWithoutLinkExists
+                      then do
+                        printIOMsg "Reconstruct the phylo from an existing file without links"
+                        phyloWithoutLink <- readPhylo backupPhyloWithoutLink
+                        writePhylo backupPhyloWithoutLink phyloWithoutLink
+                        pure $ toPhylo (setConfig config phyloWithoutLink)
+                      else do
+                        printIOMsg "Reconstruct the phylo from scratch"
+                        phyloWithoutLink <- pure $ toPhyloWithoutLink corpus config
+                        writePhylo backupPhyloWithoutLink phyloWithoutLink
+                        pure $ toPhylo (setConfig config phyloWithoutLink)
+
+      writePhylo backupPhylo phylo
+
+      printIOMsg "End of reconstruction, start the export"
+
+      let dot = toPhyloExport (setConfig config phylo)
+
+      let output = configToLabel config
+
+      dotToFile output dot
+
+phyloCmd :: HasCallStack => Mod CommandFields CLI
+phyloCmd = command "phylo" (info (helper <*> fmap CLISub phylo_p) (progDesc "Phylo toolkit."))
+
+phylo_p :: Parser CLICmd
+phylo_p = fmap CCMD_phylo $ PhyloArgs
+  <$> ( strOption ( long "config"
+                    <> metavar "FILEPATH"
+                    <> help "Path to a file containing a JSON to be parsed into a PhyloConfig"
+                    ) )

bin/gargantext-phylo/Phylo/Common.hs → bin/gargantext-cli/CLI/Phylo/Common.hs

 {-# LANGUAGE OverloadedStrings #-}
-module Common where
+module CLI.Phylo.Common where
 
 import Control.Concurrent.Async (mapConcurrently)
 import Crypto.Hash.SHA256 (hash)
@@ -99,6 +99,8 @@ tsvToDocs parser patterns time path =
                                        (map (T.strip . pack) $ splitOn ";" (unpack $ (tsv'_source row)))
                                        time
                      ) <$> snd <$> Tsv.readWeightedTsv path
+    Csv _  -> panicTrace "CSV is currently not supported."
+    Csv' _ -> panicTrace "CSV is currently not supported."
 
 
 -- To parse a file into a list of Document
@@ -109,6 +111,8 @@ fileToDocsAdvanced parser path time lst = do
       Wos limit  -> wosToDocs limit  patterns time path
       Tsv  _     -> tsvToDocs parser patterns time path
       Tsv' _     -> tsvToDocs parser patterns time path
+      Csv  _     -> panicTrace "CSV is currently not supported."
+      Csv' _     -> panicTrace "CSV is currently not supported."
 
 fileToDocsDefault :: CorpusParser -> FilePath -> [TimeUnit] -> TermList -> IO [Document]
 fileToDocsDefault parser path timeUnits lst = 

bin/gargantext-phylo-profile/Main.hs → bin/gargantext-cli/CLI/Phylo/Profile.hs

 {-# LANGUAGE OverloadedStrings #-}
-module Main where
+module CLI.Phylo.Profile where
 
-import Common
+import CLI.Phylo.Common
 import Data.Aeson
 import Data.List (nub)
 import Gargantext.Core.Viz.Phylo
 import Gargantext.Core.Viz.Phylo.API.Tools
 import Gargantext.Core.Viz.Phylo.PhyloExport (toPhyloExport, dotToFile)
 import Gargantext.Core.Viz.Phylo.PhyloMaker  (toPhylo, toPhyloWithoutLink)
-import Gargantext.Core.Viz.Phylo.PhyloTools  (printIOMsg, printIOComment, setConfig, toPeriods, getTimePeriod, getTimeStep)
+import Gargantext.Core.Viz.Phylo.PhyloTools
 import GHC.IO.Encoding
 import GHC.Stack
 import Paths_gargantext
 import Prelude
-import qualified Data.Text as T
-import Shelly
+import Shelly hiding (command)
 import System.Directory
+import Options.Applicative
+import CLI.Types
 
 --------------
 -- | Main | --
@@ -46,8 +47,8 @@ phyloConfig outdir = PhyloConfig {
   }
 
 
-main :: HasCallStack => IO ()
-main = do
+phyloProfileCLI :: HasCallStack => IO ()
+phyloProfileCLI = do
 
     shelly $ escaping False $ withTmpDir $ \tdir -> do
       curDir <- pwd
@@ -110,3 +111,8 @@ main = do
 
           dotToFile output dot
         echo "Done."
+
+phyloProfileCmd :: HasCallStack => Mod CommandFields CLI
+phyloProfileCmd =
+  command "phylo-profile" (info (helper <*> fmap CLISub (pure CCMD_phylo_profile))
+                          (progDesc "Helper to profile phylo code."))

bin/gargantext-cli/CLI/Server/Routes.hs

+{-# LANGUAGE TypeApplications    #-}
+{-# LANGUAGE TypeOperators       #-}
+{-# LANGUAGE LambdaCase          #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# OPTIONS_GHC -Wno-orphans     #-}
+
+module CLI.Server.Routes (
+    routesCLI
+  , routesCmd
+  ) where
+
+import CLI.Types
+import Data.Aeson.Encode.Pretty
+import Data.ByteString qualified as B
+import Data.ByteString.Lazy qualified as BL
+import Gargantext.API.Routes.Named
+import Options.Applicative
+import Prelude
+import Servant.API
+import Servant.API.Routes
+import Servant.Auth qualified as Servant
+
+routesCmd :: Mod CommandFields CLI
+routesCmd = command "routes" (info (helper <*> (fmap CLISub $ fmap CCMD_routes routesParser))
+                                   (progDesc "Server routes related commands."))
+
+routesParser :: Parser CLIRoutes
+routesParser = hsubparser (
+  (command "list" (info (helper <*> list_p)
+                                   (progDesc "List all the available routes, computed by the Routes types."))) <>
+  (command "export" (info (helper <*> export_p)
+                                   (progDesc "Exports all the routes into a file, for golden-diff testing.")))
+  )
+
+list_p :: Parser CLIRoutes
+list_p = pure CLIR_list
+
+export_p :: Parser CLIRoutes
+export_p = CLIR_export <$>
+  strOption ( long "file" <> metavar "output.json" <> help "Export the routes to a file." )
+
+instance HasRoutes api => HasRoutes (Servant.Auth xs a :> api) where
+  getRoutes = getRoutes @api
+
+instance HasRoutes Raw where
+  getRoutes = []
+
+routesCLI :: CLIRoutes -> IO ()
+routesCLI = \case
+  CLIR_list
+    -> printRoutes @(NamedRoutes API)
+  (CLIR_export filePath)
+    -> B.writeFile filePath . BL.toStrict $ encodePretty (getRoutes @(NamedRoutes API))

bin/gargantext-cli/CLI/Types.hs

+
+module CLI.Types where
+
+import Data.String
+import Data.Text (Text)
+import Gargantext.API.Admin.Settings
+import Gargantext.Core.Types (NodeId)
+import Gargantext.Core.Types.Query
+import Prelude
+
+newtype CorpusFile = CorpusFile { _CorpusFile :: FilePath }
+  deriving (Show, Eq, IsString)
+
+newtype TermListFile = TermListFile { _TermsListFile :: FilePath }
+  deriving (Show, Eq, IsString)
+
+newtype OutputFile = OutputFile { _OutputFile :: FilePath }
+  deriving (Show, Eq, IsString)
+
+data ObfuscateDBArgs = ObfuscateDBArgs {
+    dbHost     :: !Text
+  , dbPort     :: !Int
+  , dbName     :: !Text
+  , dbUser     :: !Text
+  , dbPassword :: !Text
+  } deriving (Show, Eq)
+
+data AdminArgs = AdminArgs
+  { iniPath      :: !IniFile
+  , settingsPath :: !SettingsFile
+  , emails       :: [String]
+  } deriving (Show, Eq)
+
+data ImportFunction
+  = IF_corpus
+  | IF_corpusTsvHal
+  | IF_annuaire
+  deriving (Show, Eq, Enum, Bounded)
+
+data ImportArgs = ImportArgs
+  { imp_function :: !ImportFunction
+  , imp_user     :: !Text
+  , imp_name     :: !Text
+  , imp_ini      :: !IniFile
+  , imp_settings :: !SettingsFile
+  , imp_limit    :: !Limit
+  , imp_corpus_path :: !FilePath
+  } deriving (Show, Eq)
+
+data InitArgs = InitArgs
+  { init_ini      :: !IniFile
+  , init_settings :: !SettingsFile
+  } deriving (Show, Eq)
+
+data InvitationsArgs = InvitationsArgs
+  { inv_path    :: !IniFile
+  , inv_settings :: !SettingsFile
+  , inv_user    :: !Text
+  , inv_node_id :: !NodeId
+  , inv_email   :: !Text
+  } deriving (Show, Eq)
+
+data PhyloArgs = PhyloArgs
+  { phylo_config :: !FilePath
+  } deriving (Show, Eq)
+
+data UpgradeArgs = UpgradeArgs
+  { upgrade_ini      :: !IniFile
+  , upgrade_settings :: !SettingsFile
+  } deriving (Show, Eq)
+
+data GoldenFileDiffArgs = GoldenFileDiffArgs
+  { gdf_expected :: !FilePath
+  , gdf_actual   :: !FilePath
+  } deriving (Show, Eq)
+
+data CLIRoutes
+  = CLIR_list
+  | CLIR_export FilePath
+  deriving (Show, Eq)
+
+data CLICmd
+  = CCMD_clean_csv_corpus
+  | CCMD_filter_terms_and_cooc !CorpusFile !TermListFile !OutputFile
+  | CCMD_obfuscate_db !ObfuscateDBArgs
+  | CCMD_admin !AdminArgs
+  | CCMD_import !ImportArgs
+  | CCMD_init !InitArgs
+  | CCMD_invitations !InvitationsArgs
+  | CCMD_phylo !PhyloArgs
+  | CCMD_phylo_profile
+  | CCMD_upgrade !UpgradeArgs
+  | CCMD_golden_file_diff !GoldenFileDiffArgs
+  | CCMD_routes !CLIRoutes
+  deriving (Show, Eq)
+
+data CLI =
+  CLISub CLICmd
+  deriving (Show, Eq)
+
+

bin/gargantext-upgrade/Main.hs → bin/gargantext-cli/CLI/Upgrade.hs

 {-|
-Module      : Main.hs
+Module      : Upgrade.hs
 Description : Gargantext Import Corpus
 Copyright   : (c) CNRS, 2017-Present
 License     : AGPL + CECILL v3
@@ -7,24 +7,28 @@ Maintainer  : team@gargantext.org
 Stability   : experimental
 Portability : POSIX
 
-Import a corpus binary.
+Upgrade a gargantext node.
 
  -}
 
 {-# LANGUAGE Strict            #-}
 {-# LANGUAGE QuasiQuotes       #-}
 
-module Main where
+module CLI.Upgrade where
 
+import CLI.Types
+import CLI.Parsers
 import Data.List qualified as List (cycle, concat, take, unlines)
+import Gargantext.API.Admin.Settings
 import Gargantext.API.Dev (withDevEnv)
 import Gargantext.API.Node () -- instances only
+import Gargantext.Core.Config (GargConfig(..), readConfig)
 import Gargantext.Prelude
-import Gargantext.Prelude.Config (GargConfig(..), readConfig)
+import Options.Applicative
 import Prelude qualified
 
-main :: IO ()
-main = do
+upgradeCLI :: UpgradeArgs -> IO ()
+upgradeCLI (UpgradeArgs iniPath settingsFile) = do
 
   let ___ = putStrLn ((List.concat
                        $ List.take 72
@@ -34,11 +38,6 @@ main = do
   putStrLn ("GarganText upgrade to version 0.0.6.9.9.4.4" :: Text)
   ___
 
-  params@[iniPath] <- getArgs
-  _ <- if length params /= 1
-         then panicTrace "Usage: ./gargantext-upgrade gargantext.ini"
-         else pure ()
-
   putStrLn $ List.unlines
            [ "Your Database defined in gargantext.ini will be upgraded."
            , "We stronlgy recommend you to make a backup using pg_dump."
@@ -48,10 +47,10 @@ main = do
 
   _ok  <- getLine
 
-  cfg       <- readConfig         iniPath
+  cfg       <- readConfig (_IniFile iniPath)
   let _secret = _gc_secretkey cfg
 
-  withDevEnv iniPath $ \_env -> do
+  withDevEnv iniPath settingsFile $ \_env -> do
     -- _ <- runCmdDev env addIndex
     -- _ <- runCmdDev env refreshIndex
 
@@ -92,3 +91,11 @@ main = do
 --         CREATE INDEX IF NOT EXISTS node_stories_ngrams_id_idx
 --           ON node_stories(ngrams_id);
 --   |]
+
+upgradeCmd :: HasCallStack => Mod CommandFields CLI
+upgradeCmd = command "upgrade" (info (helper <*> fmap CLISub upgrade_p) (progDesc "Upgrade a Gargantext node."))
+
+upgrade_p :: Parser CLICmd
+upgrade_p = fmap CCMD_upgrade $ UpgradeArgs
+  <$> ini_p
+  <*> settings_p

bin/gargantext-cli/CLI/Utils.hs

+
+module CLI.Utils (
+    mapMP
+  , mapConcurrentlyChunked
+  ) where
+
+import Control.Concurrent.Async as CCA (mapConcurrently)
+import Data.List.Split (chunksOf)
+import Gargantext.Prelude
+import System.IO (hFlush)
+
+------------------------------------------------------------------------
+-- | Tools
+mapMP :: MonadIO m => (a -> m b) -> [a] -> m [b]
+mapMP f xs = do
+    bs <- zipWithM g (cycle "-\\|/") xs
+    liftIO $ hPutStr stderr ("\rDone\n" :: Text)
+    pure bs
+  where
+    g c x = do
+      liftIO $ hPutStr stderr ['\r',c]
+      liftIO $ hFlush  stderr
+      f x
+
+-- | Optimi that need further developments (not used yet)
+mapConcurrentlyChunked :: (a -> IO b) -> [a] -> IO [b]
+mapConcurrentlyChunked f ts = do
+  caps <- getNumCapabilities
+  let n = 1 `max` (length ts `div` caps)
+  concat <$> mapConcurrently (mapM f) (chunksOf n ts)
+
+

bin/gargantext-cli/Main.hs

@@ -12,129 +12,74 @@ Main specifications to index a corpus with a term list
  -}
 
 {-# LANGUAGE Strict             #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE TypeApplications #-}
 
 module Main where
 
-import Control.Concurrent.Async as CCA (mapConcurrently)
-import Data.Aeson ( ToJSON, encode )
-import Data.List.Split (chunksOf)
-import Data.Map.Strict qualified as DM
-import Data.Text (pack)
-import Data.Text qualified as DT
-import Data.Text.Lazy qualified as DTL
-import Data.Text.Lazy.Encoding qualified as TLE
-import Data.Tuple.Extra (both)
-import Data.Vector qualified as DV
-import Gargantext.Core.Text.Context (TermList)
-import Gargantext.Core.Text.Corpus.Parsers.TSV (readTSVFile, tsv_title, tsv_abstract, tsv_publication_year, fromMIntOrDec, defaultYear)
-import Gargantext.Core.Text.List.Formats.TSV (tsvMapTermList)
-import Gargantext.Core.Text.Metrics.Count (coocOnContexts, Coocs)
-import Gargantext.Core.Text.Terms.WithList ( Patterns, buildPatterns, extractTermsWithList )
-import Gargantext.Prelude
-import System.IO (hFlush)
+import Prelude
+
+import CLI.FilterTermsAndCooc
+import CLI.ObfuscateDB (obfuscateDB, obfuscateDBCmd)
+import CLI.Types
+import Options.Applicative
+import CLI.Admin (adminCLI, adminCmd)
+import CLI.FileDiff (fileDiffCLI, fileDiffCmd)
+import CLI.Import (importCLI, importCmd)
+import CLI.Init (initCLI, initCmd)
+import CLI.Invitations (invitationsCLI, invitationsCmd)
+import CLI.Phylo (phyloCLI, phyloCmd)
+import CLI.Phylo.Profile (phyloProfileCLI, phyloProfileCmd)
+import CLI.Server.Routes (routesCLI, routesCmd)
+import CLI.Upgrade (upgradeCLI, upgradeCmd)
+
+runCLI :: CLI -> IO ()
+runCLI = \case
+  CLISub CCMD_clean_csv_corpus
+    -> putStrLn "TODO."
+  CLISub (CCMD_filter_terms_and_cooc corpusFile termListFile outputFile)
+    -> filterTermsAndCoocCLI corpusFile termListFile outputFile
+  CLISub (CCMD_obfuscate_db args)
+    -> obfuscateDB args
+  CLISub (CCMD_admin args)
+    -> adminCLI args
+  CLISub (CCMD_import args)
+    -> importCLI args
+  CLISub (CCMD_init args)
+    -> initCLI args
+  CLISub (CCMD_invitations args)
+    -> invitationsCLI args
+  CLISub (CCMD_phylo args)
+    -> phyloCLI args
+  CLISub CCMD_phylo_profile
+    -> phyloProfileCLI
+  CLISub (CCMD_upgrade args)
+    -> upgradeCLI args
+  CLISub (CCMD_golden_file_diff args)
+    -> fileDiffCLI args
+  CLISub (CCMD_routes args)
+    -> routesCLI args
 
-------------------------------------------------------------------------
--- OUTPUT format
-
-data CoocByYear = CoocByYear { year         :: Int
-                             , nbContexts   :: NbContexts
-                             , coocurrences :: Map (Text, Text) Coocs
-                             } deriving (Show, Generic)
-
-data CoocByYears = CoocByYears { years :: [CoocByYear] }
-  deriving (Show, Generic)
-
-type NbContexts = Int
-
-instance ToJSON CoocByYear
-instance ToJSON CoocByYears
-------------------------------------------------------------------------
-
-filterTermsAndCooc
-  :: Patterns
-     -> (Int, [Text])
-     -> IO CoocByYear -- (Int, (Map (Text, Text) Coocs))
-filterTermsAndCooc patterns (year, ts) = do
-  logWork "start"
-  r <- coocOnContexts identity <$> mapM (\x -> {-log "work" >>-} terms' patterns x) ts
-  logWork "stop"
-  pure $ CoocByYear year (length ts) (DM.mapKeys (both DT.unwords) r)
-  where
-
-    logWork m = do
-      tid    <- myThreadId
-      (p, _) <- threadCapability tid
-      putText . unwords $
-        ["filterTermsAndCooc:", m, show year, "on proc", show p]
 
 main :: IO ()
-main = do
-  [corpusFile, termListFile, outputFile] <- getArgs
-
-  --corpus :: IO (DM.IntMap [[Text]])
-  eCorpusFile <- readTSVFile corpusFile
-  case eCorpusFile of
-    Right cf -> do
-      let corpus = DM.fromListWith (<>)
-                   . DV.toList
-                   . DV.map (\n -> (fromMIntOrDec defaultYear $ tsv_publication_year n, [(tsv_title n) <> " " <> (tsv_abstract n)]))
-                   . snd $ cf
-
-      -- termListMap :: [Text]
-      termList <- tsvMapTermList termListFile
-
-      putText $ show $ length termList
-
-      let patterns = buildPatterns termList
-
-      -- r <- mapConcurrentlyChunked (filterTermsAndCooc patterns) (DM.toList corpus)
-      r <-  mapConcurrently (filterTermsAndCooc patterns) (DM.toList corpus)
-      writeFile outputFile $ DTL.toStrict $ TLE.decodeUtf8 $ encode (CoocByYears r)
-    Left e -> panicTrace $ "Error: " <> e
-
-
-
-------------------------------------------------------------------------
--- | Tools
-mapMP :: MonadIO m => (a -> m b) -> [a] -> m [b]
-mapMP f xs = do
-    bs <- zipWithM g (cycle "-\\|/") xs
-    liftIO $ hPutStr stderr ("\rDone\n" :: Text)
-    pure bs
+main = runCLI =<< execParser opts
   where
-    g c x = do
-      liftIO $ hPutStr stderr ['\r',c]
-      liftIO $ hFlush  stderr
-      f x
-
--- | Optimi that need further developments (not used yet)
-mapConcurrentlyChunked :: (a -> IO b) -> [a] -> IO [b]
-mapConcurrentlyChunked f ts = do
-  caps <- getNumCapabilities
-  let n = 1 `max` (length ts `div` caps)
-  concat <$> mapConcurrently (mapM f) (chunksOf n ts)
-
-
---terms' :: Patterns -> Text -> Corpus [[Text]]
-terms' :: Applicative f => Patterns -> Text -> f [[Text]]
-terms' pats txt = pure $ concat $ extractTermsWithList pats txt
-
-
--- | TODO Minimal Example
---testCooc = do
---  let patterns = buildPatterns testTermList
---  mapM (\x -> {-log "work" >>-} terms' patterns x) $ catMaybes $ map (head . snd) testCorpus
---  --mapConcurrently (filterTermsAndCooc patterns) testCorpus
-
-
-testCorpus :: [(Int, [Text])]
-testCorpus = [ (1998, [pack "The beees"])
-             , (1999, [ pack "The bees and the flowers"
-                      --, pack "The bees and the flowers"
-                      ])
-             ]
-
-testTermList :: TermList
-testTermList = [ ([pack "bee"], [[pack "bees"]])
-               , ([pack "flower"], [[pack "flowers"]])
-               ]
+    opts = info (helper <*> allOptions)
+      ( fullDesc
+     <> progDesc "CLI for the gargantext-server. Type --help for all the commands."
+     <> header "gargantext-cli tools" )
+
+allOptions :: Parser CLI
+allOptions = subparser (
+                 filterTermsAndCoocCmd <>
+                 obfuscateDBCmd <>
+                 adminCmd <>
+                 importCmd <>
+                 initCmd <>
+                 invitationsCmd <>
+                 phyloCmd <>
+                 phyloProfileCmd <>
+                 upgradeCmd <>
+                 fileDiffCmd <>
+                 routesCmd
+                 )

bin/gargantext-phylo/Main.hs

-{-|
-Module      : Main.hs
-Description : Gargantext starter binary with Adaptative Phylo
-Copyright   : (c) CNRS, 2017-Present
-License     : AGPL + CECILL v3
-Maintainer  : team@gargantext.org
-Stability   : experimental
-Portability : POSIX
-
-Adaptative Phylo binaries
- -}
-
-{-# LANGUAGE StandaloneDeriving #-}
-{-# LANGUAGE TypeOperators      #-}
-{-# LANGUAGE Strict             #-}
-
-module Main where
-
-import Control.Concurrent.Async (mapConcurrently)
-import Crypto.Hash.SHA256 (hash)
-import Data.Aeson
-import Data.ByteString.Char8 qualified as C8
-import Data.List  (nub, isSuffixOf, tail)
-import Data.List.Split
-import Data.Maybe (fromJust)
-import Data.Text  (unpack, replace, pack)
-import Data.Text qualified as T
-import Data.Vector qualified as Vector
-import GHC.IO.Encoding
-import Gargantext.API.Ngrams.Prelude (toTermList)
-import Gargantext.API.Ngrams.Types
-import Gargantext.Core.Text.Context (TermList)
-import Gargantext.Core.Text.Corpus.Parsers (FileFormat(..), FileType(..), parseFile)
-import Gargantext.Core.Text.Corpus.Parsers.TSV (tsv_title, tsv_abstract, tsv_publication_year, tsv_publication_month, tsv_publication_day, tsv'_source, tsv'_title, tsv'_abstract, tsv'_publication_year, tsv'_publication_month, tsv'_publication_day, tsv'_weight)
-import Gargantext.Core.Text.Corpus.Parsers.TSV qualified as Tsv
-import Gargantext.Core.Text.List.Formats.TSV (tsvMapTermList)
-import Gargantext.Core.Text.Ngrams (NgramsType(..))
-import Gargantext.Core.Text.Terms.WithList (Patterns, buildPatterns, extractTermsWithList)
-import Gargantext.Core.Types.Main (ListType(..))
-import Gargantext.Core.Viz.Phylo
-import Gargantext.Core.Viz.Phylo.API.Tools
-import Gargantext.Core.Viz.Phylo.PhyloExport (toPhyloExport, dotToFile)
-import Gargantext.Core.Viz.Phylo.PhyloMaker  (toPhylo, toPhyloWithoutLink)
-import Gargantext.Core.Viz.Phylo.PhyloTools  (printIOMsg, printIOComment, setConfig, toPeriods, getTimePeriod, getTimeStep)
-import Gargantext.Database.Admin.Types.Hyperdata (HyperdataDocument(..))
-import Gargantext.Prelude hiding (hash, replace)
-import Prelude qualified
-import System.Directory (listDirectory,doesFileExist)
-import Common
-
-main :: IO ()
-main = do
-
-    setLocaleEncoding utf8
-    currentLocale <- getLocaleEncoding
-    printIOMsg $ "Machine locale: " <> show currentLocale
-    printIOMsg "Starting the reconstruction"
-
-    printIOMsg "Read the configuration file"
-    [args]   <- getArgs
-    jsonArgs <- (eitherDecode <$> readJson args) :: IO (Either Prelude.String PhyloConfig)
-
-    case jsonArgs of
-        Left err     -> putStrLn err
-        Right config -> do
-
-            printIOMsg "Parse the corpus"
-            mapList <-  fileToList (listParser config) (listPath config)
-
-            corpus  <- if (defaultMode config)
-                        then fileToDocsDefault (corpusParser config) (corpusPath config) [Year 3 1 5,Month 3 1 5,Week 4 2 5] mapList
-                        else fileToDocsAdvanced (corpusParser config) (corpusPath config) (timeUnit config)  mapList
-
-            printIOComment (show (length corpus) <> " parsed docs from the corpus")
-
-            printIOComment (show (length $ nub $ concat $ map text corpus) <> " Size ngs_coterms")
-
-            printIOComment (show (length mapList) <> " Size ngs_terms List Map Ngrams")
-
-            printIOMsg "Reconstruct the phylo"
-
-            -- check the existing backup files
-
-            let backupPhyloWithoutLink = (outputPath config) <> "backupPhyloWithoutLink_" <> (configToSha BackupPhyloWithoutLink config) <> ".json"
-            let backupPhylo = (outputPath config) <> "backupPhylo_"   <> (configToSha BackupPhylo config) <> ".json"
-
-            phyloWithoutLinkExists <- doesFileExist backupPhyloWithoutLink
-            phyloExists   <- doesFileExist backupPhylo
-
-            -- reconstruct the phylo
-
-            phylo <- if phyloExists
-                        then do
-                          printIOMsg "Reconstruct the phylo from an existing file"
-                          readPhylo backupPhylo
-                        else do
-                          if phyloWithoutLinkExists
-                            then do
-                              printIOMsg "Reconstruct the phylo from an existing file without links"
-                              phyloWithoutLink <- readPhylo backupPhyloWithoutLink
-                              writePhylo backupPhyloWithoutLink phyloWithoutLink
-                              pure $ toPhylo (setConfig config phyloWithoutLink)
-                            else do
-                              printIOMsg "Reconstruct the phylo from scratch"
-                              phyloWithoutLink <- pure $ toPhyloWithoutLink corpus config
-                              writePhylo backupPhyloWithoutLink phyloWithoutLink
-                              pure $ toPhylo (setConfig config phyloWithoutLink)
-
-            writePhylo backupPhylo phylo
-
-            printIOMsg "End of reconstruction, start the export"
-
-            let dot = toPhyloExport (setConfig config phylo)
-
-            let output = configToLabel config
-
-            dotToFile output dot

bin/gargantext-server/Main.hs

@@ -24,12 +24,14 @@ module Main where
 
 import Data.Text (unpack)
 import Data.Version (showVersion)
+import GHC.IO.Encoding
 import Gargantext.API (startGargantext) -- , startGargantextMock)
 import Gargantext.API.Admin.EnvTypes
+import Gargantext.API.Admin.Settings
 import Gargantext.Prelude
 import Gargantext.System.Logging
-import GHC.IO.Encoding
 import Options.Generic
+import Prelude (String)
 import System.Exit (exitSuccess)
 import qualified Paths_gargantext as PG -- cabal magic build module
 
@@ -45,6 +47,8 @@ data MyOptions w =
                         <?> "By default: 8008"
             , ini  :: w ::: Maybe Text
                         <?> "Ini-file path of gargantext.ini"
+            , settings :: w ::: Maybe String
+                        <?> "By default: gargantext-settings.toml"
             , version :: w ::: Bool
                         <?> "Show version number and exit"
             }
@@ -60,7 +64,7 @@ main = withLogger () $ \ioLogger -> do
   setLocaleEncoding utf8
   currentLocale <- getLocaleEncoding
 
-  MyOptions myMode myPort myIniFile myVersion  <- unwrapRecord
+  MyOptions myMode myPort myIniFile mb_settingsFile myVersion  <- unwrapRecord
           "Gargantext server"
   ---------------------------------------------------------------
   if myVersion then do
@@ -75,12 +79,16 @@ main = withLogger () $ \ioLogger -> do
 
       myIniFile' = case myIniFile of
           Nothing -> panicTrace "[ERROR] gargantext.ini needed"
+          Just i  -> IniFile $ unpack i
+
+      settingsFile = SettingsFile $ case mb_settingsFile of
+          Nothing -> "gargantext-settings.toml"
           Just i  -> i
 
   ---------------------------------------------------------------
   let start = case myMode of
         Mock -> panicTrace "[ERROR] Mock mode unsupported"
-        _ -> startGargantext myMode myPort' (unpack myIniFile')
+        _ -> startGargantext myMode myPort' myIniFile' settingsFile
   logMsg ioLogger INFO $ "Starting with "   <> show myMode <> " mode."
   logMsg ioLogger INFO $ "Machine locale: " <> show currentLocale
   start

bin/update-project-dependencies

@@ -18,8 +18,8 @@ fi
 # with the `sha256sum` result calculated on the `cabal.project` and
 # `cabal.project.freeze`. This ensures the files stay deterministic so that CI
 # cache can kick in.
-expected_cabal_project_hash="3d88bb97cd394b645692343591ae3230d5393ee07b4e805251fffb9aed4a52dd"
-expected_cabal_project_freeze_hash="09930a2fa36e4325d46e5d069595d300c6017472f405f8ac67158377816d132a"
+expected_cabal_project_hash="ec368714e0d4213dcc60e7c98344ab9a4ecbcff522deb4c57a12490e3b048585"
+expected_cabal_project_freeze_hash="ca1592c985ffead024c6635eb39b293e2525a547fe93293fdee9ce1148083f22"
 
 cabal --store-dir=$STORE_DIR v2-build --dry-run
 cabal2stack --system-ghc --allow-newer --resolver lts-21.17 --resolver-file devops/stack/lts-21.17.yaml -o stack.yaml

cabal.project

@@ -93,7 +93,7 @@ source-repository-package
 source-repository-package
     type: git
     location: https://gitlab.iscpif.fr/gargantext/crawlers/hal.git
-    tag: 3a7d039e07c8564e8ff84ef88480924d18aa5018
+    tag: 3665ccda54893d01bb27220538eefdde0c1e7419
 
 source-repository-package
     type: git
@@ -123,8 +123,7 @@ source-repository-package
 source-repository-package
     type: git
     location: https://gitlab.iscpif.fr/gargantext/haskell-gargantext-prelude
-    -- tag: 618f711a530df56caefbb1577c4bf3d5ff45e214
-    tag: d4f9bee483d41bbdf8ab4e09efb5a5a8216edff4
+    tag: bb15d828d5ef36eeaa84cccb00598b585048c88e
 
 source-repository-package
     type: git
@@ -166,6 +165,16 @@ source-repository-package
     location: https://github.com/robstewart57/rdf4h.git
     tag: 4fd2edf30c141600ffad6d730cc4c1c08a6dbce4
 
+source-repository-package
+    type: git
+    location: https://github.com/adinapoli/http-reverse-proxy.git
+    tag: c90b7bc55b0e628d0b71ccee4e222833a19792f8
+
+source-repository-package
+    type: git
+    location: https://github.com/fpringle/servant-routes.git
+    tag: 7694f62af6bc1596d754b42af16da131ac403b3a
+
 allow-older: *
 allow-newer: *
 

cabal.project.freeze

@@ -283,6 +283,7 @@ constraints: any.Cabal ==3.8.1.0,
              http-conduit +aeson,
              any.http-date ==0.0.11,
              any.http-media ==0.8.1.1,
+             any.http-reverse-proxy ==0.6.1.0,
              any.http-types ==0.12.3,
              any.http2 ==4.1.4,
              http2 -devel -h2spec,
@@ -346,6 +347,7 @@ constraints: any.Cabal ==3.8.1.0,
              any.memory ==0.18.0,
              memory +support_bytestring +support_deepseq,
              any.microlens ==0.4.13.1,
+             any.microlens-th ==0.4.3.14,
              any.microstache ==1.0.2.3,
              any.mime-mail ==0.5.1,
              any.mime-types ==0.1.2.0,
@@ -453,8 +455,10 @@ constraints: any.Cabal ==3.8.1.0,
              any.refact ==0.3.0.2,
              any.reflection ==2.1.7,
              reflection -slow +template-haskell,
+             any.regex ==1.1.0.2,
              any.regex-base ==0.94.0.2,
              any.regex-compat ==0.95.2.1,
+             any.regex-pcre-builtin ==0.95.2.3.8.44,
              any.regex-posix ==0.96.0.1,
              regex-posix -_regex-posix-clib,
              any.regex-tdfa ==1.3.2.2,
@@ -498,6 +502,7 @@ constraints: any.Cabal ==3.8.1.0,
              any.servant-job ==0.2.0.0,
              any.servant-multipart ==0.12.1,
              any.servant-multipart-api ==0.12.1,
+             any.servant-routes ==0.1.0.0,
              any.servant-server ==0.20,
              any.servant-swagger ==1.2,
              any.servant-swagger-ui ==0.3.5.5.0.0,

cabal.project.local_toCopy

+package gargantext
+    ghc-options: -fwrite-ide-info -hiedir=".stack-work/hiedb" -O0
+
+package gargantext-admin
+    ghc-options: -O0
+
+package gargantext-cli
+    ghc-options: -O0
+
+package gargantext-db-obfuscation
+    ghc-options: -O0
+
+package gargantext-import
+    ghc-options: -O0
+
+package gargantext-init
+    ghc-options: -O0
+
+package gargantext-invitations
+    ghc-options: -O0
+
+package gargantext-phylo
+    ghc-options: -O0
+
+package gargantext-server
+    ghc-options: -O0
+
+package gargantext-upgrade
+    ghc-options: -O0
+
+package gargantext-graph
+    ghc-options: -O0
+
+package hmatrix
+    ghc-options: -O0
+
+package sparse-linear
+    ghc-options: -O0
+

devops/docker/docker-compose.yaml

@@ -57,13 +57,6 @@ services:
     ports:
       - 9000:9000
 
-  johnsnownlp:
-    image: 'johnsnowlabs/nlp-server:latest'
-    volumes:
-      - js-cache:/home/johnsnowlabs/cache_pretrained
-    ports:
-      - 5000:5000
-
 volumes:
   #garg-pgdata:
   garg-pgdata14:

devops/docker/install_docker

@@ -19,8 +19,8 @@ echo \
 sudo apt-get update
 
 sudo apt-get install docker-ce docker-ce-cli containerd.io
-
+sudo apt-get install docker-compose
 # specific to our LAL config
-sudo adduser debian docker
+#sudo adduser debian docker
 
 

docs/using_stack.md

+# Building Gargantext using the Stack tool
+
+Those are the instructions for developers who wish to build Gargantext using stack instead of cabal.
+
+## Prerequisites
+
+You need [Stack](https://docs.haskellstack.org/en/stable/) (obviously). You can install it with:
+```shell
+curl -sSL https://get.haskellstack.org/ | sh
+```
+
+Check that the installation is complete with:
+```shell
+stack --version
+Version 2.9.1
+```
+
+## Building and setting up
+
+To build with stack, follow the instructions in `README.md`, with the following changes:
+
+- Replace the `cabal update` and `cabal install` commands with (still from within a Nix shell!):
+```shell
+stack build --fast
+```
+
+*Note: The default build (with optimizations) requires large amounts of RAM (16GB at least). The (recommended) `--fast` flag is here to avoid heavy compilation times and swapping out your machine; just omit it if you want to build with optimizations.*
+
+- After you have run the `docker compose up` command, install with
+```shell
+stack install
+```
+
+## Keeping the stack.yaml updated with the cabal.project
+
+Once you have a valid version of stack, building requires generating a valid `stack.yaml`. This can be obtained by installing `cabal2stack`:
+```shell
+git clone https://github.com/iconnect/cabal2stack.git
+cd cabal2stack
+```
+
+Then, depending on what build system you are using, either build with `cabal install --overwrite-policy=always` or `stack install`.
+And finally:
+```shell
+cabal2stack --system-ghc --allow-newer --resolver lts-21.17 --resolver-file devops/stack/lts-21.17.yaml -o stack.yaml
+stack build
+```
+
+The good news is you don't have to do all of this manually; during development, after modifying `cabal.project`, it's enough to run:
+```shell
+./bin/update-project-dependencies
+```

gargantext-cors-settings.toml → gargantext-settings.toml

+
+[cors]
+
 allowed-origins = [
     "https://demo.gargantext.org"
   , "https://formation.gargantext.org"
@@ -15,3 +18,7 @@ allowed-origins = [
   ]
 
 use-origins-for-hosts = true
+
+[microservices.proxy]
+port    = 8009
+enabled = false

src/Gargantext/API.hs

@@ -35,6 +35,7 @@ module Gargantext.API
       where
 
 import Control.Concurrent
+import Control.Concurrent.Async qualified as Async
 import Control.Lens hiding (Level)
 import Data.List (lookup)
 import Data.Text (pack)
@@ -43,15 +44,17 @@ import Data.Text.IO (putStrLn)
 import Data.Validity
 import Gargantext.API.Admin.Auth.Types (AuthContext)
 import Gargantext.API.Admin.EnvTypes (Env, Mode(..))
-import Gargantext.API.Admin.Settings (newEnv)
+import Gargantext.API.Admin.Settings (newEnv, IniFile(..), SettingsFile)
 import Gargantext.API.Admin.Settings.CORS
-import Gargantext.API.Admin.Types (FireWall(..), PortNumber, cookieSettings, jwtSettings, settings, corsSettings)
-import Gargantext.API.Routes.Named.EKG
+import Gargantext.API.Admin.Settings.MicroServices
+import Gargantext.API.Admin.Types (FireWall(..), PortNumber, cookieSettings, jwtSettings, settings, corsSettings, microservicesSettings)
 import Gargantext.API.Middleware (logStdoutDevSanitised)
 import Gargantext.API.Routes.Named (API)
+import Gargantext.API.Routes.Named.EKG
 import Gargantext.API.Server.Named (server)
 import Gargantext.API.Server.Named.EKG
 import Gargantext.Database.Prelude qualified as DB
+import Gargantext.MicroServices.ReverseProxy (microServicesProxyApp)
 import Gargantext.Prelude hiding (putStrLn)
 import Gargantext.System.Logging
 import Network.HTTP.Types hiding (Query)
@@ -65,15 +68,20 @@ import System.Cron.Schedule qualified as Cron
 import System.FilePath
 
 -- | startGargantext takes as parameters port number and Ini file.
-startGargantext :: Mode -> PortNumber -> FilePath -> IO ()
-startGargantext mode port file = withLoggerHoisted mode $ \logger -> do
-  env <- newEnv logger port file
+startGargantext :: Mode -> PortNumber -> IniFile -> SettingsFile -> IO ()
+startGargantext mode port iniFile settingsFile = withLoggerHoisted mode $ \logger -> do
+  env <- newEnv logger port iniFile settingsFile
+  let proxyPort = env ^. settings.microservicesSettings.msProxyPort
   runDbCheck env
-  portRouteInfo port
+  portRouteInfo port proxyPort
   app <- makeApp env
   mid <- makeGargMiddleware (env ^. settings.corsSettings) mode
   periodicActions <- schedulePeriodicActions env
-  run port (mid app) `finally` stopGargantext periodicActions
+
+  let runServer = run port (mid app) `finally` stopGargantext periodicActions
+  let runProxy  = run proxyPort (mid (microServicesProxyApp env))
+
+  Async.race_ runServer runProxy
 
   where runDbCheck env = do
           r <- runExceptT (runReaderT DB.dbCheck env) `catch`
@@ -81,17 +89,18 @@ startGargantext mode port file = withLoggerHoisted mode $ \logger -> do
           case r of
             Right True -> pure ()
             _ -> panicTrace $
-              "You must run 'gargantext-init " <> pack file <>
+              "You must run 'gargantext-init " <> pack (_IniFile iniFile) <>
               "' before running gargantext-server (only the first time)."
 
-portRouteInfo :: PortNumber -> IO ()
-portRouteInfo port = do
+portRouteInfo :: PortNumber -> PortNumber -> IO ()
+portRouteInfo mainPort proxyPort = do
   putStrLn   "=========================================================================================================="
   putStrLn   " GarganText Main Routes"
   putStrLn   "=========================================================================================================="
-  putStrLn $ " - Web GarganText Frontend..................: " <> "http://localhost:" <> toUrlPiece port <> "/index.html"
-  putStrLn $ " - Swagger UI (API documentation)...........: " <> "http://localhost:" <> toUrlPiece port <> "/swagger-ui"
-  putStrLn $ " - Playground GraphQL (API documentation)...: " <> "http://localhost:" <> toUrlPiece port <> "/gql"
+  putStrLn $ " - Web GarganText Frontend..................: " <> "http://localhost:" <> toUrlPiece mainPort <> "/index.html"
+  putStrLn $ " - Swagger UI (API documentation)...........: " <> "http://localhost:" <> toUrlPiece mainPort <> "/swagger-ui"
+  putStrLn $ " - Playground GraphQL (API documentation)...: " <> "http://localhost:" <> toUrlPiece mainPort <> "/gql"
+  putStrLn $ " - Microservices proxy .....................: " <> "http://localhost:" <> toUrlPiece proxyPort
   putStrLn   "=========================================================================================================="
 
 -- | Stops the gargantext server and cancels all the periodic actions

src/Gargantext/API/Admin/EnvTypes.hs

@@ -12,6 +12,7 @@ module Gargantext.API.Admin.EnvTypes (
   , mkJobHandle
   , env_logger
   , env_manager
+  , env_settings
   , env_self_url
   , menv_firewall
   , dev_env_logger
@@ -40,8 +41,8 @@ import Gargantext.Core.NLP (NLPServerMap, HasNLPServer(..))
 import Gargantext.Core.NodeStory
 import Gargantext.Database.Prelude (HasConnectionPool(..), HasConfig(..))
 import Gargantext.Prelude
-import Gargantext.Prelude.Config (GargConfig(..))
-import Gargantext.Prelude.Mail.Types (MailConfig)
+import Gargantext.Core.Config (GargConfig(..))
+import Gargantext.Core.Config.Mail (MailConfig)
 import Gargantext.System.Logging
 import Gargantext.Utils.Jobs.Map (LoggerM, J(..), jTask, rjGetLog)
 import Gargantext.Utils.Jobs.Monad qualified as Jobs

src/Gargantext/API/Admin/Settings.hs

@@ -25,10 +25,9 @@ import Control.Monad.Logger (LogLevel(..))
 import Control.Monad.Reader
 import Data.ByteString.Lazy qualified as L
 import Data.Pool (Pool)
-import qualified Data.Pool as Pool
 import Database.PostgreSQL.Simple (Connection, connect, close, ConnectInfo)
 import Gargantext.API.Admin.EnvTypes
-import Gargantext.API.Admin.Settings.CORS
+import Gargantext.API.Admin.Settings.TOML (GargTomlSettings(..), loadGargTomlSettings)
 import Gargantext.API.Admin.Types
 import Gargantext.API.Errors.Types
 import Gargantext.API.Prelude
@@ -36,10 +35,9 @@ import Gargantext.Core.NLP (nlpServerMap)
 import Gargantext.Core.NodeStory
 import Gargantext.Database.Prelude (databaseParameters, hasConfig)
 import Gargantext.Prelude
-import Gargantext.Prelude.Config (gc_js_job_timeout, gc_js_id_timeout)
-import Gargantext.Prelude.Config ({-GargConfig(..),-} {-gc_repofilepath,-} readConfig)
-import Gargantext.Prelude.Mail qualified as Mail
-import Gargantext.Prelude.NLP qualified as NLP
+import Gargantext.Core.Config (gc_js_job_timeout, gc_js_id_timeout, readConfig)
+import Gargantext.Core.Config.Mail qualified as Mail
+import Gargantext.Core.Config.NLP qualified as NLP
 import Gargantext.System.Logging
 import Gargantext.Utils.Jobs qualified as Jobs
 import Gargantext.Utils.Jobs.Monad qualified as Jobs
@@ -52,15 +50,26 @@ import Servant.Job.Async (newJobEnv, defaultSettings)
 import System.Directory
 import System.IO (hClose)
 import System.IO.Temp (withTempFile)
+import qualified Data.Pool as Pool
+
+newtype JwkFile = JwkFile { _JwkFile :: FilePath }
+  deriving (Show, Eq, IsString)
+
+newtype SettingsFile = SettingsFile { _SettingsFile :: FilePath }
+  deriving (Show, Eq, IsString)
+
+newtype IniFile  = IniFile { _IniFile :: FilePath }
+  deriving (Show, Eq, IsString)
 
-devSettings :: FilePath -> IO Settings
-devSettings jwkFile = do
+devSettings :: JwkFile -> SettingsFile -> IO Settings
+devSettings (JwkFile jwkFile) (SettingsFile settingsFile) = do
   jwkExists <- doesFileExist jwkFile
   when (not jwkExists) $ writeKey jwkFile
   jwk       <- readKey jwkFile
-  gargCorsSettings <- loadGargCorsSettings
+  GargTomlSettings{..} <- loadGargTomlSettings settingsFile
   pure $ Settings
-    { _corsSettings = gargCorsSettings
+    { _corsSettings = _gargCorsSettings
+    , _microservicesSettings = _gargMicroServicesSettings
     , _appPort = 3000
     , _logLevelLimit = LevelDebug
 --    , _dbServer = "localhost"
@@ -171,13 +180,13 @@ readRepoEnv repoDir = do
   pure $ RepoEnv { _renv_var = mvar, _renv_saver = saver, _renv_lock = lock }
 --}
 
-devJwkFile :: FilePath
-devJwkFile = "dev.jwk"
+devJwkFile :: JwkFile
+devJwkFile = JwkFile "dev.jwk"
 
-newEnv :: Logger (GargM Env BackendInternalError) -> PortNumber -> FilePath -> IO Env
-newEnv logger port file = do
+newEnv :: Logger (GargM Env BackendInternalError) -> PortNumber -> IniFile -> SettingsFile -> IO Env
+newEnv logger port (IniFile file) settingsFile = do
   !manager_env  <- newTlsManager
-  !settings'    <- devSettings devJwkFile <&> appPort .~ port -- TODO read from 'file'
+  !settings'    <- devSettings devJwkFile settingsFile <&> appPort .~ port -- TODO read from 'file'
   when (port /= settings' ^. appPort) $
     panicTrace "TODO: conflicting settings of port"
 

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

@@ -6,13 +6,11 @@ module Gargantext.API.Admin.Settings.CORS where
 
 import Prelude
 
+import Control.Arrow
 import Data.Text qualified as T
 import Toml
-import Gargantext.System.Logging
-import Paths_gargantext
-import Data.String
-import Control.Arrow
-import Control.Lens.TH
+import Control.Lens hiding (iso, (.=))
+import Data.String (IsString)
 
 newtype CORSOrigin = CORSOrigin { _CORSOrigin :: T.Text }
   deriving (Show, Eq, IsString)
@@ -35,23 +33,9 @@ corsOriginCodec = _Orig >>> _Text
    _Orig = iso _CORSOrigin CORSOrigin
 
 corsSettingsCodec :: TomlCodec CORSSettings
-corsSettingsCodec = CORSSettings <$> (Toml.arrayOf corsOriginCodec "allowed-origins" .= _corsAllowedOrigins)
+corsSettingsCodec = CORSSettings
+     <$> Toml.arrayOf corsOriginCodec "allowed-origins" .= _corsAllowedOrigins
      <*> pure mempty -- FIXME(adn) Currently we don't need to support this field.
      <*> Toml.bool "use-origins-for-hosts" .= _corsUseOriginsForHosts
 
--- | Loads the 'CORSSettings' from the 'toml' file.
-loadGargCorsSettings :: IO CORSSettings
-loadGargCorsSettings = do
-  corsFile <- getDataFileName "gargantext-cors-settings.toml"
-  tomlRes <- Toml.decodeFileEither corsSettingsCodec corsFile
-  case tomlRes of
-      Left errs      -> do
-        withLogger () $ \ioLogger -> do
-          logMsg ioLogger WARNING $ T.unpack $ "Error, gargantext-cors-settings.toml parsing failed: " <> Toml.prettyTomlDecodeErrors errs
-          pure $ CORSSettings ["http://localhost:8008"] ["http://localhost:3000"] False
-      Right settings0 -> case _corsUseOriginsForHosts settings0 of
-        True  -> pure $ settings0 { _corsAllowedHosts = "http://localhost:3000" : (_corsAllowedOrigins settings0) }
-        False -> pure $ settings0 { _corsAllowedHosts = "http://localhost:3000" : (_corsAllowedHosts settings0) }
-
-
 makeLenses ''CORSSettings

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

+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TemplateHaskell   #-}
+module Gargantext.API.Admin.Settings.MicroServices where
+
+import Prelude
+
+import Control.Lens.TH
+import Data.Text qualified as T
+import Gargantext.Core.Config
+import Servant.Client.Core.BaseUrl
+import Toml
+
+data MicroServicesSettings =
+  MicroServicesSettings {
+    -- | The port where the microservices proxy will be listening on.
+    _msProxyPort    :: !Int
+  , _msProxyEnabled :: !Bool
+  } deriving (Show, Eq)
+
+microServicesSettingsCodec :: TomlCodec MicroServicesSettings
+microServicesSettingsCodec = MicroServicesSettings
+  <$> Toml.int  "port"    .= _msProxyPort
+  <*> Toml.bool "enabled" .= _msProxyEnabled
+
+mkProxyUrl :: GargConfig -> MicroServicesSettings -> BaseUrl
+mkProxyUrl GargConfig{..} MicroServicesSettings{..} =
+  case parseBaseUrl (T.unpack _gc_url) of
+    Nothing -> BaseUrl Http "localhost" 80 ""
+    Just bh -> bh { baseUrlPort = _msProxyPort }
+
+
+makeLenses ''MicroServicesSettings

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

+{-# LANGUAGE TemplateHaskell #-}
+module Gargantext.API.Admin.Settings.TOML where
+
+import Control.Lens hiding ((.=))
+import Data.Text qualified as T
+import Gargantext.API.Admin.Settings.CORS
+import Gargantext.API.Admin.Settings.MicroServices
+import Gargantext.Prelude (panicTrace)
+import Gargantext.System.Logging
+import Prelude
+import Toml
+import Servant.Client.Core.BaseUrl
+
+-- | Compatibility bridge until we fix #304 (move to Toml)
+data GargTomlSettings = GargTomlSettings
+  { _gargCorsSettings          :: !CORSSettings
+  , _gargMicroServicesSettings :: !MicroServicesSettings
+  }
+
+makeLenses ''GargTomlSettings
+
+settingsCodec :: TomlCodec GargTomlSettings
+settingsCodec = GargTomlSettings
+  <$> (Toml.table corsSettingsCodec "cors" .= _gargCorsSettings)
+  <*> (Toml.table  microServicesSettingsCodec "microservices.proxy" .= _gargMicroServicesSettings)
+
+-- | Extends the 'allowed-origins' in the CORSettings with the URLs embellished
+-- with the proxy port.
+addProxyToAllowedOrigins :: GargTomlSettings -> GargTomlSettings
+addProxyToAllowedOrigins stgs =
+  stgs & over gargCorsSettings (addProxies $ stgs ^. gargMicroServicesSettings . msProxyPort)
+  where
+    addProxies :: Int -> CORSSettings -> CORSSettings
+    addProxies port cors =
+      let origins = _corsAllowedOrigins cors
+          mkUrl (CORSOrigin u) = case parseBaseUrl (T.unpack u) of
+            Nothing -> CORSOrigin u
+            Just bh -> CORSOrigin $ T.pack $ showBaseUrl $ bh { baseUrlPort = port }
+      in cors { _corsAllowedOrigins = origins <> Prelude.map mkUrl origins }
+
+-- | Loads the 'CORSSettings' from the 'toml' file.
+loadGargTomlSettings :: FilePath -> IO GargTomlSettings
+loadGargTomlSettings tomlFile = do
+  tomlRes <- Toml.decodeFileEither settingsCodec tomlFile
+  case tomlRes of
+      Left errs      -> do
+        withLogger () $ \ioLogger -> do
+          logMsg ioLogger ERROR $ T.unpack $ "Error, gargantext-settings.toml parsing failed: " <> Toml.prettyTomlDecodeErrors errs
+          panicTrace "Please fix the errors in your gargantext-settings.toml file."
+      Right settings0 -> case settings0 ^. gargCorsSettings . corsUseOriginsForHosts of
+        True  -> pure $ addProxyToAllowedOrigins $ settings0 & over (gargCorsSettings . corsAllowedHosts) (\_ -> "http://localhost:3000" : (settings0 ^. gargCorsSettings . corsAllowedOrigins))
+        False -> pure $ addProxyToAllowedOrigins $ settings0 & over (gargCorsSettings . corsAllowedHosts) ("http://localhost:3000" :)

src/Gargantext/API/Admin/Types.hs

@@ -9,6 +9,7 @@ import Gargantext.API.Admin.Settings.CORS
 import Gargantext.Prelude
 import Servant.Auth.Server (JWTSettings, CookieSettings(..))
 import Servant.Client (BaseUrl)
+import Gargantext.API.Admin.Settings.MicroServices
 
 
 type PortNumber = Int
@@ -20,6 +21,7 @@ data SendEmailType = SendEmailViaAws
 
 data Settings = Settings
     { _corsSettings          :: !CORSSettings   -- CORS settings
+    , _microservicesSettings :: !MicroServicesSettings
     , _appPort               :: !PortNumber
     , _logLevelLimit         :: !LogLevel -- log level from the monad-logger package
 --    , _dbServer        :: Text

src/Gargantext/API/Auth/PolicyCheck.hs

@@ -2,6 +2,7 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeFamilies        #-}
 {-# LANGUAGE TypeOperators       #-}
+{-# LANGUAGE TypeApplications    #-}
 
 module Gargantext.API.Auth.PolicyCheck (
     AccessCheck(..)
@@ -31,15 +32,16 @@ import Gargantext.Database.Prelude (DBCmd, HasConfig (..))
 import Gargantext.Database.Query.Table.Node.Error
 import Gargantext.Database.Query.Tree
 import Gargantext.Database.Query.Tree.Root
-import Gargantext.Prelude.Config (GargConfig(..))
+import Gargantext.Core.Config (GargConfig(..))
 import Prelude
 import Servant
+import Servant.API.Routes
 import Servant.Auth.Server.Internal.AddSetCookie
+import Servant.Client.Core
 import Servant.Ekg
 import Servant.Server.Internal.Delayed
 import Servant.Server.Internal.DelayedIO
-import qualified Servant.Swagger as Swagger
-import Servant.Client.Core
+import Servant.Swagger qualified as Swagger
 
 -------------------------------------------------------------------------------
 -- Types
@@ -203,6 +205,11 @@ instance HasClient m sub => HasClient m (PolicyChecked sub) where
 
   hoistClientMonad pm _ nt cl = hoistClientMonad pm (Proxy :: Proxy sub) nt . cl
 
+instance (HasRoutes subApi) => HasRoutes (PolicyChecked subApi) where
+  getRoutes =
+    let apiRoutes = getRoutes @subApi
+    in  apiRoutes
+
 -------------------------------------------------------------------------------
 -- Utility functions
 -------------------------------------------------------------------------------

src/Gargantext/API/Dev.hs

@@ -17,23 +17,22 @@ import Control.Monad (fail)
 import Data.Pool (withResource)
 import Database.PostgreSQL.Simple qualified as PGS
 import Gargantext.API.Admin.EnvTypes ( DevEnv(..), Mode(Dev) )
-import Gargantext.API.Admin.Settings ( devJwkFile, devSettings, newPool )
+import Gargantext.API.Admin.Settings ( devJwkFile, devSettings, newPool, SettingsFile (..), IniFile (..) )
 import Gargantext.API.Errors.Types ( BackendInternalError )
 import Gargantext.API.Prelude ( GargM )
 import Gargantext.Core.NLP (nlpServerMap)
 import Gargantext.Core.NodeStory (fromDBNodeStoryEnv)
 import Gargantext.Database.Prelude (Cmd', Cmd'', connPool, databaseParameters, runCmd)
 import Gargantext.Prelude
-import Gargantext.Prelude.Config (readConfig)
-import Gargantext.Prelude.Mail qualified as Mail
-import Gargantext.Prelude.NLP qualified as NLP
+import Gargantext.Core.Config (readConfig)
+import Gargantext.Core.Config.Mail qualified as Mail
+import Gargantext.Core.Config.NLP qualified as NLP
 import Gargantext.System.Logging ( withLoggerHoisted )
 import Servant ( ServerError )
 
-type IniPath  = FilePath
 -------------------------------------------------------------------
-withDevEnv :: IniPath -> (DevEnv -> IO a) -> IO a
-withDevEnv iniPath k = withLoggerHoisted Dev $ \logger -> do
+withDevEnv :: IniFile -> SettingsFile -> (DevEnv -> IO a) -> IO a
+withDevEnv (IniFile iniPath) settingsFile k = withLoggerHoisted Dev $ \logger -> do
   env <- newDevEnv logger
   k env -- `finally` cleanEnv env
 
@@ -44,7 +43,7 @@ withDevEnv iniPath k = withLoggerHoisted Dev $ \logger -> do
       --nodeStory_env <- fromDBNodeStoryEnv (_gc_repofilepath cfg)
       pool    <- newPool            dbParam
       nodeStory_env <- fromDBNodeStoryEnv pool
-      setts   <- devSettings devJwkFile
+      setts   <- devSettings devJwkFile settingsFile
       mail    <- Mail.readConfig iniPath
       nlp_config <- NLP.readConfig iniPath
       pure $ DevEnv
@@ -57,9 +56,15 @@ withDevEnv iniPath k = withLoggerHoisted Dev $ \logger -> do
         , _dev_env_nlp      = nlpServerMap nlp_config
         }
 
+defaultIniFile :: IniFile
+defaultIniFile = IniFile "gargantext.ini"
+
+defaultSettingsFile :: SettingsFile
+defaultSettingsFile = SettingsFile "gargantext-settings.toml"
+
 -- | Run Cmd Sugar for the Repl (GHCI)
 runCmdRepl :: Show err => Cmd'' DevEnv err a -> IO a
-runCmdRepl f = withDevEnv "gargantext.ini" $ \env -> runCmdDev env f
+runCmdRepl f = withDevEnv defaultIniFile defaultSettingsFile $ \env -> runCmdDev env f
 
 runCmdReplServantErr :: Cmd'' DevEnv ServerError a -> IO a
 runCmdReplServantErr = runCmdRepl
@@ -83,7 +88,7 @@ runCmdDevServantErr :: DevEnv -> Cmd' DevEnv ServerError a -> IO a
 runCmdDevServantErr = runCmdDev
 
 runCmdReplEasy :: Cmd'' DevEnv BackendInternalError a -> IO a
-runCmdReplEasy f = withDevEnv "gargantext.ini" $ \env -> runCmdDev env f
+runCmdReplEasy f = withDevEnv defaultIniFile defaultSettingsFile $ \env -> runCmdDev env f
 
 -- | Execute a function that takes PSQL.Connection from the DB pool as
 --   first parameter.

src/Gargantext/API/GraphQL/Context.hs

@@ -22,7 +22,8 @@ import Data.Morpheus.Types
   , ResolverM
   , QUERY
   )
-import Data.Text (pack)
+import Data.Text (pack, unpack)
+import qualified Data.Text as Text
 import Data.Time.Format.ISO8601 (iso8601Show)
 import Gargantext.API.Admin.Types (HasSettings)
 import Gargantext.API.Errors.Types ( BackendInternalError )
@@ -94,6 +95,7 @@ data ContextsForNgramsArgs
   = ContextsForNgramsArgs
     { corpus_id    :: Int
     , ngrams_terms :: [Text]
+    , and_logic    :: Text
     } deriving (Generic, GQLType)
 
 data NodeContextCategoryMArgs = NodeContextCategoryMArgs
@@ -123,8 +125,8 @@ resolveNodeContext NodeContextArgs { context_id, node_id } =
 resolveContextsForNgrams
   :: (CmdCommon env)
   => ContextsForNgramsArgs -> GqlM e env [ContextGQL]
-resolveContextsForNgrams ContextsForNgramsArgs { corpus_id, ngrams_terms } =
-  dbContextForNgrams corpus_id ngrams_terms
+resolveContextsForNgrams ContextsForNgramsArgs { corpus_id, ngrams_terms, and_logic } =
+  dbContextForNgrams corpus_id ngrams_terms and_logic
 
 resolveContextNgrams
   :: (CmdCommon env)
@@ -149,9 +151,9 @@ dbNodeContext context_id node_id = do
 -- | Returns list of `ContextGQL` for given ngrams in given corpus id.
 dbContextForNgrams
   :: (CmdCommon env)
-  => Int -> [Text] -> GqlM e env [ContextGQL]
-dbContextForNgrams node_id ngrams_terms = do
-  contextsForNgramsTerms <- lift $ getContextsForNgramsTerms (UnsafeMkNodeId node_id) ngrams_terms
+  => Int -> [Text] -> Text -> GqlM e env [ContextGQL]
+dbContextForNgrams node_id ngrams_terms and_logic = do
+  contextsForNgramsTerms <- lift $ getContextsForNgramsTerms (UnsafeMkNodeId node_id) ngrams_terms ( readMaybe $ unpack $ Text.toTitle and_logic )
   --lift $ printDebug "[dbContextForNgrams] contextsForNgramsTerms" contextsForNgramsTerms
   pure $ toContextGQL <$> contextsForNgramsTerms
 

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

@@ -57,7 +57,7 @@ import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata)
 import Gargantext.Database.Query.Tree.Root (MkCorpusUser(MkCorpusUserNormalCorpusIds))
 import Gargantext.Database.Schema.Node (node_hyperdata)
 import Gargantext.Prelude
-import Gargantext.Prelude.Config (gc_max_docs_parsers)
+import Gargantext.Core.Config (gc_max_docs_parsers)
 import Gargantext.System.Logging ( logLocM, LogLevel(..) )
 import Gargantext.Utils.Jobs.Monad (JobHandle, MonadJobStatus(..))
 import Test.QuickCheck.Arbitrary (Arbitrary(..))
@@ -150,7 +150,9 @@ type AddWithFile = Summary "Add with MultipartData to corpus endpoint"
 addToCorpusWithQuery :: ( FlowCmdM env err m
                         , MonadJobStatus m
                         , HasNodeStoryImmediateSaver env
-                        , HasNodeArchiveStoryImmediateSaver env )
+                        , HasNodeArchiveStoryImmediateSaver env
+                        , HasSettings env
+                        )
                        => User
                        -> CorpusId
                        -> WithQuery
@@ -222,7 +224,9 @@ addToCorpusWithQuery user cid (WithQuery { _wq_query = q
 addToCorpusWithForm :: ( FlowCmdM env err m
                        , MonadJobStatus m
                        , HasNodeStoryImmediateSaver env
-                       , HasNodeArchiveStoryImmediateSaver env )
+                       , HasNodeArchiveStoryImmediateSaver env
+                       , HasSettings env
+                       )
                     => User
                     -> CorpusId
                     -> NewWithForm

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

@@ -43,11 +43,12 @@ import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
 import Gargantext.Database.Query.Tree.Error (HasTreeError)
 import Gargantext.Database.Query.Tree.Root (getOrMkRootWithCorpus, MkCorpusUser (MkCorpusUserMaster))
 import Gargantext.Prelude hiding (All)
-import Gargantext.Prelude.Config (GargConfig(..))
+import Gargantext.Core.Config (GargConfig(..))
 import Gargantext.Utils.Jobs.Monad (JobHandle, MonadJobStatus(..))
 import Network.HTTP.Client
 import Network.HTTP.Client.TLS (tlsManagerSettings)
 import Prelude qualified
+import Gargantext.API.Admin.Types (HasSettings)
 
 langToSearx :: Lang -> Text
 langToSearx x   = Text.toLower acronym <> "-" <> acronym
@@ -120,7 +121,9 @@ insertSearxResponse :: ( MonadBase IO m
                        , HasNLPServer env
                        , HasNodeError err
                        , HasTreeError err
-                       , HasValidationError err )
+                       , HasValidationError err
+                       , HasSettings env
+                       )
                     => User
                     -> CorpusId
                     -> ListId
@@ -163,7 +166,9 @@ triggerSearxSearch :: ( MonadBase IO m
                       , HasNodeError err
                       , HasTreeError err
                       , HasValidationError err
-                      , MonadJobStatus m )
+                      , MonadJobStatus m
+                      , HasSettings env
+                      )
                    => User
                    -> CorpusId
                    -> Query.RawQuery

src/Gargantext/API/Node/DocumentUpload.hs

@@ -20,6 +20,7 @@ import Control.Lens (view)
 import Data.Text qualified as T
 import Gargantext.API.Admin.EnvTypes (GargJob(..), Env)
 import Gargantext.API.Admin.Orchestrator.Types
+import Gargantext.API.Admin.Types (HasSettings)
 import Gargantext.API.Errors.Types ( BackendInternalError )
 import Gargantext.API.Node.DocumentUpload.Types
 import Gargantext.API.Prelude ( GargM )
@@ -44,7 +45,7 @@ api nId = Named.DocumentUploadAPI $ AsyncJobs $
   serveJobsAPI UploadDocumentJob $ \jHandle q -> do
       documentUploadAsync nId q jHandle
 
-documentUploadAsync :: (FlowCmdM env err m, MonadJobStatus m)
+documentUploadAsync :: (FlowCmdM env err m, MonadJobStatus m, HasSettings env)
                => NodeId
                -> DocumentUpload
                -> JobHandle m
@@ -55,7 +56,7 @@ documentUploadAsync nId doc jobHandle = do
   -- printDebug "documentUploadAsync" docIds
   markComplete jobHandle
 
-documentUpload :: (FlowCmdM env err m)
+documentUpload :: (FlowCmdM env err m, HasSettings env)
                => NodeId
                -> DocumentUpload
                -> m [DocId]

src/Gargantext/API/Node/FrameCalcUpload.hs

@@ -41,6 +41,7 @@ import Gargantext.Utils.Jobs (serveJobsAPI, MonadJobStatus(..), markFailureNoErr
 import Network.HTTP.Client (newManager, httpLbs, parseRequest, responseBody)
 import Network.HTTP.Client.TLS (tlsManagerSettings)
 import Servant.Server.Generic (AsServerT)
+import Gargantext.API.Admin.Types (HasSettings)
 
 
 api :: AuthenticatedUser -> NodeId -> Named.FrameCalcAPI (AsServerT (GargM Env BackendInternalError))
@@ -53,7 +54,9 @@ api authenticatedUser nId = Named.FrameCalcAPI $ AsyncJobs $
 frameCalcUploadAsync :: ( HasConfig env
                         , FlowCmdM env err m
                         , MonadJobStatus m
-                        , HasNodeArchiveStoryImmediateSaver env )
+                        , HasNodeArchiveStoryImmediateSaver env
+                        , HasSettings env
+                        )
                      => AuthenticatedUser
                      -- ^ The logged-in user
                      -> NodeId

src/Gargantext/API/Node/New.hs

@@ -31,19 +31,20 @@ import Gargantext.API.Routes.Named.Node qualified as Named
 import Gargantext.Database.Action.Flow.Types
 import Gargantext.Database.Action.Node
 import Gargantext.Database.Admin.Types.Node
-import Gargantext.Database.Prelude (Cmd)
+import Gargantext.Database.Prelude (DBCmd')
 import Gargantext.Database.Query.Table.Node.Error (HasNodeError(..))
 import Gargantext.Prelude
 import Gargantext.Utils.Jobs (serveJobsAPI, MonadJobStatus(..))
 import Servant.Server.Generic (AsServerT)
+import Gargantext.API.Admin.Types (HasSettings)
 
 ------------------------------------------------------------------------
-postNode :: HasNodeError err
+postNode :: (HasNodeError err, HasSettings env)
          => AuthenticatedUser
          -- ^ The logged-in user
          -> NodeId
          -> PostNode
-         -> Cmd err [NodeId]
+         -> DBCmd' env err [NodeId]
 postNode authenticatedUser pId (PostNode nodeName nt) = do
   let userId = authenticatedUser ^. auth_user_id
   mkNodeWithParent nt (Just pId) userId nodeName
@@ -58,7 +59,7 @@ postNodeAsyncAPI authenticatedUser nId = Named.PostNodeAsyncAPI $ AsyncJobs $
   serveJobsAPI NewNodeJob $ \jHandle p -> postNodeAsync authenticatedUser nId p jHandle
 
 ------------------------------------------------------------------------
-postNodeAsync :: (FlowCmdM env err m, MonadJobStatus m)
+postNodeAsync :: (FlowCmdM env err m, MonadJobStatus m, HasSettings env)
     => AuthenticatedUser
     -- ^ The logged in user
     -> NodeId

src/Gargantext/API/Node/Share.hs

@@ -32,12 +32,13 @@ import Gargantext.Database.Query.Table.Node.Error (HasNodeError(..))
 import Gargantext.Database.Query.Tree (findNodesWithType)
 import Gargantext.Prelude
 import Servant.Server.Generic (AsServerT)
+import Gargantext.API.Admin.Types (HasSettings)
 
 ------------------------------------------------------------------------
 -- TODO permission
 -- TODO refactor userId which is used twice
 -- TODO change return type for better warning/info/success/error handling on the front
-api :: (HasNodeError err, HasNLPServer env, CmdRandom env err m)
+api :: (HasNodeError err, HasNLPServer env, CmdRandom env err m, HasSettings env)
     => User
     -> NodeId
     -> ShareNodeParams

src/Gargantext/API/Node/ShareURL.hs

@@ -9,7 +9,7 @@ import Gargantext.API.Prelude
 import Gargantext.Core.Types (NodeType, NodeId, unNodeId)
 import Gargantext.Database.Prelude (HasConfig (hasConfig), CmdCommon)
 import Control.Lens.Getter (view)
-import Gargantext.Prelude.Config (gc_url)
+import Gargantext.Core.Config (gc_url)
 import Gargantext.API.Routes.Named.Share qualified as Named
 import Servant.Server.Generic (AsServerT)
 

src/Gargantext/API/Routes.hs

@@ -34,7 +34,7 @@ import Gargantext.API.Routes.Named.Corpus qualified as Named
 import Gargantext.Core.Types.Individu (User(..))
 import Gargantext.Database.Prelude (HasConfig(..))
 import Gargantext.Prelude
-import Gargantext.Prelude.Config (gc_max_docs_scrapers)
+import Gargantext.Core.Config (gc_max_docs_scrapers)
 import Gargantext.Utils.Jobs (serveJobsAPI, MonadJobStatus(..))
 import Servant
 import Servant.Auth.Swagger ()

src/Gargantext/API/Routes/Named/Private.hs

@@ -16,8 +16,10 @@ module Gargantext.API.Routes.Named.Private (
   ) where
 
 
+import Data.Kind
 import Data.Text (Text)
 import GHC.Generics
+import GHC.TypeLits
 import Gargantext.API.Admin.Auth.Types
 import Gargantext.API.Auth.PolicyCheck
 import Gargantext.API.Routes.Named.Contact
@@ -25,19 +27,17 @@ import Gargantext.API.Routes.Named.Context
 import Gargantext.API.Routes.Named.Corpus
 import Gargantext.API.Routes.Named.Count
 import Gargantext.API.Routes.Named.Document
-import Gargantext.API.Routes.Named.Node
 import Gargantext.API.Routes.Named.List qualified as List
+import Gargantext.API.Routes.Named.Node
 import Gargantext.API.Routes.Named.Share
-import Gargantext.API.Routes.Named.Tree
 import Gargantext.API.Routes.Named.Table
+import Gargantext.API.Routes.Named.Tree
 import Gargantext.API.Routes.Named.Viz
 import Gargantext.Database.Admin.Types.Hyperdata.Any
 import Gargantext.Database.Admin.Types.Hyperdata.Corpus
 import Gargantext.Database.Admin.Types.Node
 import Servant.API
 import Servant.Auth qualified as SA
-import Data.Kind
-import GHC.TypeLits
 
 
 type MkProtectedAPI private = SA.Auth '[SA.JWT, SA.Cookie] AuthenticatedUser :> private

src/Gargantext/API/Routes/Types.hs

 {-# LANGUAGE TypeFamilies         #-}
 {-# LANGUAGE ScopedTypeVariables  #-}
+{-# LANGUAGE TypeApplications     #-}
 module Gargantext.API.Routes.Types where
 
+import Control.Lens
+import Data.ByteString (ByteString)
 import Data.List qualified as L
 import Data.Proxy
+import Data.Set qualified as Set
 import Gargantext.API.Errors
-import Network.Wai
+import Network.Wai hiding (responseHeaders)
 import Prelude
-import Servant.Client
+import Servant.API.Routes
+import Servant.Client hiding (responseHeaders)
 import Servant.Ekg
 import Servant.Server
 import Servant.Server.Internal.Delayed
 import Servant.Server.Internal.DelayedIO
+import Servant.API.Routes.Route
+import Servant.API.Routes.Internal.Response (unResponses)
 
 data WithCustomErrorScheme a
 
@@ -37,3 +44,10 @@ instance HasClient m sub => HasClient m (WithCustomErrorScheme sub) where
   clientWithRoute m _ req _mgr = clientWithRoute m (Proxy :: Proxy sub) req
 
   hoistClientMonad pm _ nt cl = hoistClientMonad pm (Proxy :: Proxy sub) nt . cl
+
+instance (HasRoutes subApi) => HasRoutes (WithCustomErrorScheme subApi) where
+  getRoutes =
+    let apiRoutes = getRoutes @subApi
+        errHeader = mkHeaderRep @"X-Garg-Error-Scheme" @ByteString
+        addHeader rt = rt & routeResponse . unResponses . traversed . responseHeaders %~ Set.insert errHeader
+    in  addHeader <$> apiRoutes

src/Gargantext/API/Server/Named.hs

@@ -24,22 +24,22 @@ import Gargantext.API.Swagger (swaggerDoc)
 import Gargantext.API.ThrowAll (serverPrivateGargAPI)
 import Gargantext.Database.Prelude (hasConfig)
 import Gargantext.Prelude hiding (Handler, catch)
-import Gargantext.Prelude.Config (gc_url_backend_api)
+import Gargantext.Core.Config (gc_url_backend_api)
 import Gargantext.System.Logging (logLocM, LogLevel(..))
 import Paths_gargantext qualified as PG -- cabal magic build module
 import Servant
 import Servant.Server.Generic
 import Servant.Swagger.UI (swaggerSchemaUIServer)
 
-serverGargAPI :: Text -> BackEndAPI (AsServerT (GargM Env BackendInternalError))
-serverGargAPI baseUrl
+serverGargAPI :: Env -> BackEndAPI (AsServerT (GargM Env BackendInternalError))
+serverGargAPI env
        =  BackEndAPI $ MkBackEndAPI $ GargAPIVersion $ GargAPI'
             { gargAuthAPI                = AuthAPI auth
             , gargForgotPasswordAPI      = forgotPassword
             , gargForgotPasswordAsyncAPI = forgotPasswordAsync
             , gargVersionAPI             = gargVersion
             , gargPrivateAPI             = serverPrivateGargAPI
-            , gargPublicAPI              = serverPublicGargAPI baseUrl
+            , gargPublicAPI              = serverPublicGargAPI (env ^. hasConfig . gc_url_backend_api)
             }
   where
     gargVersion :: GargVersion (AsServerT (GargM Env BackendInternalError))
@@ -54,7 +54,7 @@ server env =
                       (Proxy :: Proxy (NamedRoutes BackEndAPI))
                       (Proxy :: Proxy AuthContext)
                       (transformJSON errScheme)
-                      (serverGargAPI (env ^. hasConfig . gc_url_backend_api))
+                      (serverGargAPI env)
      , graphqlAPI = hoistServerWithContext
                       (Proxy :: Proxy (NamedRoutes GraphQLAPI))
                       (Proxy :: Proxy AuthContext)

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

@@ -9,15 +9,15 @@ import Data.HashMap.Strict as HM
 import Data.Text as T
 import Data.Text.IO as T
 import Data.Time.Clock.POSIX (getPOSIXTime)
+import Gargantext.API.Routes.Named.EKG
 import Network.Wai
 import Protolude
 import Servant
 import Servant.Auth
 import Servant.Ekg
-import System.Metrics
-import qualified System.Metrics.Json as J
-import Gargantext.API.Routes.Named.EKG
 import Servant.Server.Generic
+import System.Metrics
+import System.Metrics.Json qualified as J
 
 
 ekgServer :: FilePath -> Store -> EkgAPI AsServer

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

-
+{-# OPTIONS_GHC -Wno-deprecations #-}
 module Gargantext.API.Server.Named.Private where
 
 import Gargantext.API.Admin.Auth.Types (AuthenticatedUser(..))
@@ -26,7 +26,6 @@ import Gargantext.Prelude
 import Servant.Auth.Swagger ()
 import Servant.Server.Generic (AsServerT)
 
-
 ---------------------------------------------------------------------
 -- | Server declarations
 

src/Gargantext/API/ThrowAll.hs

@@ -9,19 +9,22 @@ Portability : POSIX
 
 -}
 
-{-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE KindSignatures         #-}
 {-# LANGUAGE LambdaCase             #-}
 {-# LANGUAGE MonoLocalBinds         #-}
+{-# LANGUAGE PolyKinds              #-}
+{-# LANGUAGE ScopedTypeVariables    #-}
+{-# LANGUAGE TypeApplications       #-}
 {-# LANGUAGE TypeOperators          #-}
 {-# LANGUAGE UndecidableInstances   #-}
-{-# LANGUAGE TypeApplications #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE KindSignatures #-}
-{-# LANGUAGE PolyKinds #-}
 
-module Gargantext.API.ThrowAll where
+module Gargantext.API.ThrowAll (
+    throwAllRoutes
+  , serverPrivateGargAPI
+  ) where
 
 import Control.Lens ((#))
+import Data.ByteString.Char8 qualified as C8
 import Gargantext.API.Admin.Auth.Types
 import Gargantext.API.Admin.EnvTypes (Env)
 import Gargantext.API.Errors.Types
@@ -29,31 +32,60 @@ import Gargantext.API.Prelude
 import Gargantext.API.Routes.Named.Private qualified as Named
 import Gargantext.API.Server.Named.Private qualified as Named
 import Gargantext.Database.Admin.Types.Node (UserId (..))
-import Gargantext.Prelude
+import Gargantext.Prelude hiding (Handler)
+import Network.HTTP.Types.Status (Status(..))
+import Network.Wai (responseLBS)
 import Servant
+import Servant.API.Generic ()
 import Servant.Auth.Server (AuthResult(..))
 import Servant.Server.Generic (AsServerT)
-import Servant.API.Generic ()
 
+-- | Slightly more general version of the 'ThrowAll' typeclass from Servant,
+-- that works on a generic error.
+class ThrowAll' e a where
+  throwAll' :: e -> a -> a
+
+instance (ThrowAll' e a, ThrowAll' e b) => ThrowAll' e (a :<|> b) where
+  throwAll' e (s1 :<|> s2) = throwAll' e s1 :<|> throwAll' e s2
 
-throwAll' :: forall err m routes. ( MonadError err m
-         , HasServerError err
+instance ThrowAll' e b => ThrowAll' e (a -> b) where
+  throwAll' e f = \x -> throwAll' e (f x)
+
+instance ( MonadError e m
+         , GenericServant routes (AsServerT m)
          , HasServer (NamedRoutes routes) '[]
          , Generic (routes (AsServerT m))
-         ) => err
-           -> routes (AsServerT m)
-           -> routes (AsServerT m)
-throwAll' errCode server =
-  hoistServer (Proxy @(NamedRoutes routes)) f server
+         ) => ThrowAll' e (routes (AsServerT m)) where
+  throwAll' errCode server = hoistServer (Proxy @(NamedRoutes routes)) f server
     where
       f :: forall a. m a -> m a
       f = const (throwError errCode)
 
+-- Common instances
+
+instance (ThrowAll' ServerError (Handler a)) where
+  throwAll' e _ = throwError e
+instance (ThrowAll' ServerError (Tagged Handler Application)) where
+  throwAll' ServerError{..} (Tagged _) =
+    Tagged $ \_ mkResponse -> mkResponse (responseLBS (Status errHTTPCode (C8.pack errReasonPhrase)) errHeaders errBody)
+
+
+throwAllRoutes :: ( MonadError e m
+            , Generic (routes (AsServerT m))
+            , GenericServant routes (AsServerT m)
+            , ThrowAll' e (routes (AsServerT m))
+            , ThrowAll' e (ToServant routes (AsServerT m))
+            )
+         => e
+         -> routes (AsServerT m)
+         -> routes (AsServerT m)
+throwAllRoutes err = fromServant . throwAll' err . toServant
+
 serverPrivateGargAPI :: Named.GargPrivateAPI (AsServerT (GargM Env BackendInternalError))
 serverPrivateGargAPI = Named.GargPrivateAPI $ \case
   (Authenticated auser) -> Named.serverPrivateGargAPI' auser
   -- In the code below we just needed a mock 'AuthenticatedUser' to make the type check, but
   -- they will never be evaluated.
-  _                     -> throwAll' (_ServerError # err401)
+  _                     -> throwAllRoutes (_ServerError # err401)
                              $ Named.serverPrivateGargAPI' (AuthenticatedUser 0 (UnsafeMkUserId 0))
 -- Here throwAll' requires a concrete type for the monad.

src/Gargantext/Core/Config.hs

+{-|
+Module      : Gargantext.Core.Config
+Description : Textmining Collaborative Platform
+Copyright   : (c) CNRS, 2017-Present
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+
+Configuration for the gargantext server
+
+-}
+
+{-# LANGUAGE TemplateHaskell     #-}
+
+module Gargantext.Core.Config (
+    -- * Types
+    GargConfig(..)
+
+    -- * Lenses
+  , gc_backend_name
+  , gc_datafilepath
+  , gc_epo_api_url
+  , gc_frame_calc_url
+  , gc_frame_istex_url
+  , gc_frame_searx_url
+  , gc_frame_visio_url
+  , gc_frame_write_url
+  , gc_js_id_timeout
+  , gc_js_job_timeout
+  , gc_masteruser
+  , gc_max_docs_parsers
+  , gc_max_docs_scrapers
+  , gc_pubmed_api_key
+  , gc_repofilepath
+  , gc_secretkey
+  , gc_url
+  , gc_url_backend_api
+
+  -- * Utility functions
+  , readIniFile'
+  , readConfig
+  , val
+  ) where
+
+import Data.Ini (readIniFile, lookupValue, Ini)
+import Data.Text as T
+import Prelude (read)
+
+import Gargantext.Prelude
+
+
+-- | strip a given character from end of string
+stripRight :: Char -> T.Text -> T.Text
+stripRight c s = if T.last s == c then stripRight c (T.take (T.length s - 1) s) else s
+
+data GargConfig = GargConfig { _gc_backend_name      :: !T.Text
+                             , _gc_url               :: !T.Text
+                             , _gc_url_backend_api   :: !T.Text
+
+                             , _gc_masteruser        :: !T.Text
+                             , _gc_secretkey         :: !T.Text
+
+                             , _gc_datafilepath      :: !FilePath
+                             , _gc_repofilepath      :: !FilePath
+
+                             , _gc_frame_write_url   :: !T.Text
+                             , _gc_frame_calc_url    :: !T.Text
+                             , _gc_frame_visio_url   :: !T.Text
+
+                             , _gc_frame_searx_url   :: !T.Text
+                             , _gc_frame_istex_url   :: !T.Text
+
+                             , _gc_max_docs_parsers  :: !Integer
+                             , _gc_max_docs_scrapers :: !Integer
+
+                             , _gc_pubmed_api_key    :: !T.Text
+
+                             , _gc_js_job_timeout    :: !Integer
+                             , _gc_js_id_timeout     :: !Integer
+
+                             , _gc_epo_api_url       :: !T.Text
+                             }
+  deriving (Generic, Show)
+
+makeLenses ''GargConfig
+
+readIniFile' :: FilePath -> IO Ini
+readIniFile' fp = do
+  ini <- readIniFile fp
+  case ini of
+    Left e     -> panicTrace $ T.pack $ "ini file not found " <> show e
+    Right ini' -> pure ini'
+
+val :: Ini -> Text -> Text -> Text
+val ini section key = do
+  case (lookupValue section key ini) of
+    Left e   -> panicTrace $ "ERROR: add " <> key <> " in section \"" <> section <> "\" to your gargantext.ini. " <> show e
+    Right p' -> p'
+
+readConfig :: FilePath -> IO GargConfig
+readConfig fp = do
+  ini <- readIniFile' fp
+
+  let val' = val ini "gargantext"
+
+  pure $ GargConfig
+    { _gc_backend_name      = cs $ val' "BACKEND_NAME"
+    , _gc_url               = stripRight '/' $ val' "URL"
+    , _gc_url_backend_api   = stripRight '/' $ val' "URL_BACKEND_API"
+    , _gc_masteruser        = val' "MASTER_USER"
+    , _gc_secretkey         = val' "SECRET_KEY"
+    , _gc_datafilepath      = cs $ val' "DATA_FILEPATH"
+    , _gc_repofilepath      = cs $ val' "REPO_FILEPATH"
+    , _gc_frame_write_url   = stripRight '/' $ val' "FRAME_WRITE_URL"
+    , _gc_frame_calc_url    = stripRight '/' $ val' "FRAME_CALC_URL"
+    , _gc_frame_visio_url   = stripRight '/' $ val' "FRAME_VISIO_URL"
+    , _gc_frame_searx_url   = stripRight '/' $ val' "FRAME_SEARX_URL"
+    , _gc_frame_istex_url   = stripRight '/' $ val' "FRAME_ISTEX_URL"
+    , _gc_max_docs_parsers  = read $ cs $ val' "MAX_DOCS_PARSERS"
+    , _gc_max_docs_scrapers = read $ cs $ val' "MAX_DOCS_SCRAPERS"
+    , _gc_pubmed_api_key    = val' "PUBMED_API_KEY"
+    , _gc_js_job_timeout    = read $ cs $ val' "JS_JOB_TIMEOUT"
+    , _gc_js_id_timeout     = read $ cs $ val' "JS_ID_TIMEOUT"
+    , _gc_epo_api_url       = cs $ val' "EPO_API_URL"
+    }

src/Gargantext/Core/Config/Mail.hs

+{-|
+Module      : Gargantext.Core.Config.Mail
+Description :
+Copyright   : (c) CNRS, 2017-Present
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+
+-}
+
+{-# LANGUAGE TemplateHaskell #-}
+
+module Gargantext.Core.Config.Mail (
+  -- * Types
+    GargMail(..)
+  , LoginType(..)
+  , MailConfig(..)
+
+  -- * Utility functions
+  , gargMail
+  , readConfig
+
+  -- * Lenses
+  , mc_mail_from
+  , mc_mail_host
+  , mc_mail_login_type
+  , mc_mail_password
+  , mc_mail_port
+  , mc_mail_user
+  )
+  where
+
+import Data.Maybe
+import Data.Text (unpack)
+import Data.Text qualified as T
+import Gargantext.Core.Config (readIniFile', val)
+import Gargantext.Prelude
+import Network.Mail.Mime (plainPart)
+import Network.Mail.SMTP hiding (htmlPart, STARTTLS)
+import Network.Socket (PortNumber)
+import Prelude (read)
+
+
+type Email = Text
+type Name  = Text
+
+data LoginType = NoAuth | Normal | SSL | TLS | STARTTLS
+  deriving (Generic, Eq, Show, Read)
+
+data MailConfig = MailConfig { _mc_mail_host         :: !T.Text
+                             , _mc_mail_port         :: !PortNumber
+                             , _mc_mail_user         :: !T.Text
+                             , _mc_mail_password     :: !T.Text
+                             , _mc_mail_login_type   :: !LoginType
+                             , _mc_mail_from         :: !T.Text
+                             }
+  deriving (Generic, Show)
+
+readConfig :: FilePath -> IO MailConfig
+readConfig fp = do
+  ini <- readIniFile' fp
+  let val' = val ini "mail"
+
+  pure $ MailConfig { _mc_mail_host       =        cs $ val' "MAIL_HOST"
+                    , _mc_mail_port       = read $ cs $ val' "MAIL_PORT"
+                    , _mc_mail_user       =        cs $ val' "MAIL_USER"
+                    , _mc_mail_from       =        cs $ val' "MAIL_FROM"
+                    , _mc_mail_password   =        cs $ val' "MAIL_PASSWORD"
+                    , _mc_mail_login_type = read $ cs $ val' "MAIL_LOGIN_TYPE"
+                    }
+
+
+data GargMail = GargMail { gm_to      :: Email
+                         , gm_name    :: Maybe Name
+                         , gm_subject :: Text
+                         , gm_body    :: Text
+                         }
+
+-- | TODO add parameters to gargantext.ini
+gargMail :: MailConfig -> GargMail -> IO ()
+gargMail (MailConfig {..}) (GargMail { .. }) = do
+  let host     = unpack _mc_mail_host
+      user     = unpack _mc_mail_user
+      password = unpack _mc_mail_password
+  case _mc_mail_login_type of
+    NoAuth   -> sendMail                   host mail
+    Normal   -> sendMailWithLogin'         host _mc_mail_port user password mail
+    SSL      -> sendMailWithLoginTLS'      host _mc_mail_port user password mail
+    TLS      -> sendMailWithLoginTLS'      host _mc_mail_port user password mail
+    STARTTLS -> sendMailWithLoginSTARTTLS' host _mc_mail_port user password mail
+  where
+    mail = simpleMail sender receiver cc bcc gm_subject [plainPart $ cs gm_body]
+
+    sender   = Address (Just "GarganText Email") _mc_mail_from
+    receiver = [Address gm_name gm_to]
+    cc       = []
+    bcc      = []
+
+makeLenses ''MailConfig

src/Gargantext/Core/Config/NLP.hs

+{-|
+Module      : Gargantext.Core.Config.NLP
+Description :
+Copyright   : (c) CNRS, 2017-Present
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+
+-}
+
+{-# LANGUAGE TemplateHaskell #-}
+
+module Gargantext.Core.Config.NLP (
+  -- * Types
+  NLPConfig(..)
+
+  -- * Utility functions
+  , readConfig
+
+  -- * Lenses
+  , nlp_default
+  , nlp_languages
+
+  )
+  where
+
+import Data.Ini qualified as Ini
+import Data.Map.Strict qualified as Map
+import Data.Maybe
+import Data.Text qualified as T
+import Gargantext.Core.Config (readIniFile', val)
+import Gargantext.Prelude
+import Gargantext.Prelude.Utils (listToMaybeAll)
+import Network.URI (URI)
+import Network.URI (parseURI)
+
+data NLPConfig = NLPConfig { _nlp_default   :: URI
+                           , _nlp_languages :: (Map.Map T.Text URI) }
+  deriving (Generic, Show)
+
+iniSection :: Text
+iniSection = "nlp"
+
+readConfig :: FilePath -> IO NLPConfig
+readConfig fp = do
+  ini <- readIniFile' fp
+  let val' = val ini iniSection
+  let lang_default_text = "EN" -- Change this value by one of your choice: "All", "FR", or "EN"
+
+  let m_nlp_default = parseURI $ cs $ val' lang_default_text
+
+  let m_nlp_keys = filter (\k -> k `notElem` [lang_default_text]) $ fromRight [] $ Ini.keys iniSection ini
+  let m_nlp_other = listToMaybeAll $ (\k -> (,) k <$> (parseURI $ cs $ val' k)) <$> m_nlp_keys
+
+  let mRet = NLPConfig <$> m_nlp_default <*> (Map.fromList <$> m_nlp_other)
+
+  case mRet of
+    Nothing -> panicTrace $ T.concat [ "Cannot read config file: _nlp_default = "
+                                     , T.pack $ show m_nlp_default
+                                     , ", _nlp_other = "
+                                     , T.pack $ show m_nlp_other ]
+    Just ret -> pure ret
+
+makeLenses ''NLPConfig

src/Gargantext/Core/Mail.hs

@@ -19,9 +19,8 @@ import Gargantext.Core.Types.Individu
 import Gargantext.Database.Prelude (HasConfig(..))
 import Gargantext.Database.Schema.User (UserLight(..))
 import Gargantext.Prelude
-import Gargantext.Prelude.Config (gc_url, gc_backend_name)
-import Gargantext.Prelude.Mail (gargMail, GargMail(..))
-import Gargantext.Prelude.Mail.Types (MailConfig)
+import Gargantext.Core.Config (gc_url, gc_backend_name)
+import Gargantext.Core.Config.Mail (gargMail, GargMail(..), MailConfig)
 import Network.URI.Encode (encodeText)
 
 

src/Gargantext/Core/Mail/Types.hs

@@ -12,7 +12,7 @@ Portability : POSIX
 module Gargantext.Core.Mail.Types where
 
 import Control.Lens (Getter)
-import Gargantext.Prelude.Mail.Types (MailConfig)
+import Gargantext.Core.Config.Mail (MailConfig)
 
 class HasMail env where
   mailSettings :: Getter env MailConfig

src/Gargantext/Core/NLP.hs

@@ -11,12 +11,12 @@ Portability : POSIX
 module Gargantext.Core.NLP where
 
 import Control.Lens (Getter, at, non)
-import qualified Data.Map.Strict as Map
+import Data.Map.Strict qualified as Map
 import Data.Maybe (fromJust)
-import Network.URI (URI(..), parseURI)
 import Gargantext.Core (Lang(..), NLPServerConfig(..), PosTagAlgo(..), allLangs)
-import Gargantext.Prelude.NLP.Types (NLPConfig(..))
+import Gargantext.Core.Config.NLP (NLPConfig(..))
 import Gargantext.Utils.Tuple (uncurryMaybeSecond)
+import Network.URI (URI(..), parseURI)
 import Protolude hiding (All)
 
 

src/Gargantext/Core/NodeStoryFile.hs.old

@@ -27,7 +27,7 @@ import Gargantext.Core.Types (ListId, NodeId(..))
 import Gargantext.Database.Prelude (hasConfig)
 import Gargantext.Database.Query.Table.Ngrams qualified as TableNgrams
 import Gargantext.Prelude
-import Gargantext.Prelude.Config (gc_repofilepath)
+import Gargantext.Core.Config (gc_repofilepath)
 import System.Directory (renameFile, createDirectoryIfMissing, doesFileExist, removeFile)
 import System.IO (hClose)
 import System.IO.Temp (withTempFile)

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

@@ -20,6 +20,9 @@ import Data.ByteString.Lazy qualified as BL
 import Data.Csv
 import Data.Text (pack)
 import Data.Text qualified as T
+import Data.Text.Lazy            qualified as TL
+import Data.Text.Lazy.Encoding    qualified as TL
+import Data.Text.Read     qualified as DTR
 import Data.Time.Segment (jour)
 import Data.Vector (Vector)
 import Data.Vector qualified as V
@@ -205,7 +208,7 @@ hyperdataDocument2tsvDoc h = TsvDoc { tsv_title = m $ _hd_title h
     mI = maybe 0 identity
 
 
-data Delimiter = Tab | Comma
+data Delimiter = Tab | Comma | Line deriving (Eq, Show)
 
 tsvDecodeOptions :: Delimiter -> DecodeOptions
 tsvDecodeOptions d = defaultDecodeOptions {decDelimiter = delimiter d}
@@ -216,6 +219,151 @@ tsvEncodeOptions d = defaultEncodeOptions {encDelimiter = delimiter d}
 delimiter :: Delimiter -> Word8
 delimiter Tab   = fromIntegral $ ord '\t'
 delimiter Comma = fromIntegral $ ord ','
+delimiter Line  = fromIntegral $ ord '\n'
+------------------------------------------------------------------------
+
+
+testDelimiter :: Delimiter -> BL.ByteString -> Bool
+testDelimiter del bs =
+    let x = BL.splitWith (== delimiter Line) bs
+        vec = V.fromList x in
+          case BL.splitWith (== delimiter del) <$> ((V.!?) vec 0) of
+            Nothing -> False
+            Just e -> case BL.splitWith (== delimiter del) <$> ((V.!?) vec 1) of
+              Nothing -> False
+              Just f -> length e == length f && length e > 2
+
+findDelimiter :: BL.ByteString -> Either Text Delimiter
+findDelimiter bs
+  | testDelimiter Tab bs = Right Tab
+  | testDelimiter Comma bs = Right Comma
+  | otherwise = Left (pack "Problem with the delimiter : be sure that the delimiter is a tabulation for each line")
+
+isNumeric :: Text -> Either Bool Int
+isNumeric str = case DTR.decimal str of
+  Right (x,y) -> if y == ""
+    then Right x
+    else Left False
+  Left _ -> Left False
+
+lBLToText :: BL.ByteString -> Text
+lBLToText b = TL.toStrict $ TL.decodeUtf8 b
+
+validNumber :: BL.ByteString -> Text -> Int -> Either Text Bool
+validNumber x columnHeader ligne = do
+    let number = T.replace (T.pack "\"") (T.pack "") (lBLToText x)
+    case isNumeric number of
+      Right val 
+        | val < 0 -> Left $ ("Value of column '" <> columnHeader <> "' at line " <> pack (show ligne) <> " is negative")
+        |otherwise -> Right True
+      Left _ -> Left $ ("Error in column '" <> columnHeader <> "' at line " <> pack (show ligne) <> " : value is not a number ")
+
+
+validTextField :: BL.ByteString -> Text -> Int -> Either Text Bool
+validTextField x columnHeader ligne = do
+  let xs = T.replace (T.pack "\"\"") (T.pack "") (lBLToText x) in
+    if not (T.null xs) 
+      then 
+        if (T.length xs > 0) && ((T.length (T.filter (== '\"') xs) == 0) || ((T.head xs == '"') && (T.last xs == '"') && (T.length (T.filter (== '\"') xs) == 2))) 
+          then return True 
+          else Left $ ("Encapsulation problem at line " <> pack (show ligne) <> " in column '" <> columnHeader <> "' : the caracter  \"  must only appear at the beginning and the end of a field ")
+      else return True
+      -- else Left $ ("The column '" <> columnHeader <> "' at line " <>  pack (show ligne) <> " is empty")
+      -- Put a warning for the user to know their is a problem (empty column)
+
+
+testValue :: BL.ByteString -> Text -> Int -> Either Text Bool
+testValue val columnHeader ligne = case columnHeader of
+    "Publication Day" -> validNumber val columnHeader ligne
+    "Publication Month" -> validNumber val columnHeader ligne
+    "Publication Year" -> validNumber val columnHeader ligne
+    "Authors" -> validTextField val columnHeader ligne
+    "Title" -> validTextField val columnHeader ligne
+    "Source" -> validTextField val columnHeader ligne
+    "Abstract" -> validTextField val columnHeader ligne
+    _ -> Right True
+
+testErrorPerLine :: [BL.ByteString] -> Delimiter -> [Text] -> Int -> Either Text Bool
+testErrorPerLine [] _ [] _ = Right True
+testErrorPerLine _ del [] l | del == Comma = Left (pack $ "Too much field at line " <> show l <> ". Try using tabulation as a delimiter. Other delimiter like comma (,) may appear in some text.")
+                            | otherwise =  Left (pack $ "Too much field at line " <> show l)
+testErrorPerLine [] _ _ l = Left (pack $ "Missing one field at line " <> show l)
+testErrorPerLine (v:val) del (h:headers) ligne =
+    case testValue v h ligne of
+        Left _err -> Left _err
+        Right _ -> testErrorPerLine val del headers ligne
+
+
+checkNextLine :: Vector BL.ByteString -> Delimiter -> [Text] -> BL.ByteString -> Int -> Either Text (Int,[BL.ByteString])
+checkNextLine bl del headers res x = do
+  case BL.splitWith (==delimiter del) <$> ((V.!?) bl (x+1)) of
+    Nothing  -> Right (x, (BL.splitWith (==delimiter del) res))
+    Just value -> if length value > 1 
+      then Right (x, (BL.splitWith (==delimiter del) res))
+      else case BL.append res <$> ((V.!?) bl (x+1)) of
+        Nothing  -> Left "checkNextLine2"
+        Just val -> checkNextLine bl del headers val (x+1)
+
+getMultipleLinefile :: Vector BL.ByteString -> Delimiter -> [Text] -> BL.ByteString -> Int -> Either Text (Int,[BL.ByteString])
+getMultipleLinefile bl del headers res x = do
+    let tmp = BL.splitWith (==delimiter del) res in
+        if length tmp == length headers 
+          then checkNextLine bl del headers res x
+          else
+            if (length tmp > length headers) || (V.length bl == (x + 1)) 
+              then Left (pack $ "Cannot parse the file at line " <> show x <> ". Maybe because of a delimiter") 
+              else do
+                case BL.append res <$> ((V.!?) bl (x+1)) of
+                  Nothing  -> Left "getMultipleLinefile"
+                  Just val -> getMultipleLinefile bl del headers val (x+1)
+
+anx :: Vector BL.ByteString -> Delimiter -> [Text] -> Int -> Either Text Delimiter
+anx bl del headers x
+            | length bl == x = Right del
+            | otherwise      = 
+              case (V.!?) bl x of 
+                Nothing -> Left "anx"
+                Just bs ->
+                  case getMultipleLinefile bl del headers bs x of 
+                    Left _err -> Left _err
+                    Right (y, val) -> case testErrorPerLine val del headers (x + 1) of
+                      Left _err -> Left _err
+                      Right _   -> anx bl del headers (y+1)
+
+
+testIfErrorInFile :: [BL.ByteString] -> Delimiter -> [Text] -> Either Text Delimiter
+testIfErrorInFile bl del headers = anx (V.fromList bl) del headers 1
+
+testCorrectFile :: BL.ByteString -> Either Text Delimiter 
+testCorrectFile bs = 
+  case findDelimiter bs of
+    Left _err -> Left _err
+    Right del -> do
+      let bl = BL.splitWith (==delimiter Line) bs in
+        case getHeaders bl del of
+          Left _err -> Left _err
+          Right headers -> testIfErrorInFile bl del headers        
+
+
+
+----------Test headers added to ggt
+
+
+-- use a map to remove \r that sometimes appear at the end of a line
+testAllHeadersPresence :: [Text] -> Either Text [Text]
+testAllHeadersPresence headers = do
+    let listHeaders = filter (`notElem` (map (T.replace (T.pack "\r") (T.pack ""))headers)) ["Publication Day", "Publication Month", "Publication Year", "Authors", "Title", "Source", "Abstract"]
+    if null listHeaders
+        then Right headers
+        else Left ((pack " Missing column : ") <> T.intercalate ", " listHeaders)
+
+getHeaders :: [BL.ByteString] -> Delimiter -> Either Text [Text]
+getHeaders bl del = do
+    let vec = V.fromList bl in
+        case BL.splitWith (==delimiter del) <$> ((V.!?) vec 0) of 
+          Nothing -> Left "Error getHeaders"
+          Just headers -> testAllHeadersPresence (map (\x -> T.replace (T.pack "\"") (T.pack "") (lBLToText x)) headers)
+
 
 ------------------------------------------------------------------------
 
@@ -251,10 +399,10 @@ readByteStringStrict d ff = readByteStringLazy d ff . BL.fromStrict
 -- | TODO use readFileLazy
 readTSVFile :: FilePath -> IO (Either Text (Header, Vector TsvDoc))
 readTSVFile fp = do
-  result <- readTsvLazyBS Comma <$> BL.readFile fp
-  case result of
-    Left _err -> readTsvLazyBS Tab <$> BL.readFile fp
-    Right res -> pure $ Right res
+  file <- BL.readFile fp
+  case (testCorrectFile file) of
+    Left _err -> pure $ Left _err
+    Right del -> pure $ readTsvLazyBS del file
 
 
 

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

@@ -21,6 +21,7 @@ module Gargantext.Core.Viz.Graph.API
 import Control.Lens (set, _Just, (^?), at)
 import Data.HashMap.Strict qualified as HashMap
 import Gargantext.API.Admin.EnvTypes (GargJob(..), Env)
+import Gargantext.API.Admin.Types (HasSettings)
 import Gargantext.API.Errors.Types ( BackendInternalError )
 import Gargantext.API.Ngrams.Tools
 import Gargantext.API.Prelude (GargM)
@@ -36,7 +37,7 @@ import Gargantext.Database.Action.Metrics.NgramsByContext (getContextsByNgramsOn
 import Gargantext.Database.Action.Node (mkNodeWithParent)
 import Gargantext.Database.Admin.Config ( userMaster )
 import Gargantext.Database.Admin.Types.Node
-import Gargantext.Database.Prelude (DBCmd)
+import Gargantext.Database.Prelude (DBCmd, DBCmd')
 import Gargantext.Database.Query.Table.Node ( getOrMkList, getNodeWith, defaultList, getClosestParentIdByType )
 import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
 import Gargantext.Database.Query.Table.Node.Select ( selectNodesWithUsername )
@@ -266,11 +267,11 @@ recomputeVersions :: HasNodeStory env err m
 recomputeVersions nId = recomputeGraph nId Spinglass BridgenessMethod_Basic Nothing Nothing NgramsTerms NgramsTerms False
 
 ------------------------------------------------------------
-graphClone :: HasNodeError err
+graphClone :: (HasNodeError err, HasSettings env)
            => UserId
            -> NodeId
            -> HyperdataGraphAPI
-           -> DBCmd err NodeId
+           -> DBCmd' env err NodeId
 graphClone userId pId (HyperdataGraphAPI { _hyperdataAPIGraph = graph
                                          , _hyperdataAPICamera = camera }) = do
   let nodeType = NodeGraph

src/Gargantext/Database/Action/Flow.hs

@@ -90,7 +90,7 @@ import Gargantext.Database.Admin.Types.Hyperdata.Contact ( HyperdataContact )
 import Gargantext.Database.Admin.Types.Hyperdata.Corpus ( HyperdataAnnuaire, HyperdataCorpus(_hc_lang) )
 import Gargantext.Database.Admin.Types.Hyperdata.Document ( ToHyperdataDocument(toHyperdataDocument) )
 import Gargantext.Database.Admin.Types.Node hiding (DEBUG) -- (HyperdataDocument(..), NodeType(..), NodeId, UserId, ListId, CorpusId, RootId, MasterCorpusId, MasterUserId)
-import Gargantext.Database.Prelude (DbCmd', DBCmd, hasConfig)
+import Gargantext.Database.Prelude (DbCmd', hasConfig, DBCmd')
 import Gargantext.Database.Query.Table.ContextNodeNgrams2 ( ContextNodeNgrams2Poly(..), insertContextNodeNgrams2 )
 import Gargantext.Database.Query.Table.Node ( MkCorpus, insertDefaultNodeIfNotExists, getOrMkList, getNodeWith )
 import Gargantext.Database.Query.Table.Node.Document.Add qualified as Doc (add)
@@ -102,7 +102,7 @@ import Gargantext.Database.Query.Tree.Root (MkCorpusUser(..), getOrMkRoot, getOr
 import Gargantext.Database.Schema.Ngrams ( indexNgrams, text2ngrams )
 import Gargantext.Database.Schema.Node (node_hyperdata)
 import Gargantext.Prelude hiding (to)
-import Gargantext.Prelude.Config (GargConfig(..))
+import Gargantext.Core.Config (GargConfig(..))
 import Gargantext.System.Logging ( logLocM, LogLevel(DEBUG), MonadLogger )
 import Gargantext.Utils.Jobs.Monad ( JobHandle, MonadJobStatus(..) )
 import PUBMED.Types qualified as PUBMED
@@ -110,6 +110,7 @@ import PUBMED.Types qualified as PUBMED
 ------------------------------------------------------------------------
 -- Imports for upgrade function
 import Gargantext.Database.Query.Tree.Error ( HasTreeError )
+import Gargantext.API.Admin.Types (HasSettings)
 
 ------------------------------------------------------------------------
 
@@ -126,14 +127,14 @@ printDataText (DataNew (maybeInt, conduitData)) = do
   putText $ show (maybeInt, res)
 
 -- TODO use the split parameter in config file
-getDataText :: (HasNodeError err)
+getDataText :: (HasNodeError err, HasSettings env)
             => DataOrigin
             -> TermType Lang
             -> API.RawQuery
             -> Maybe PUBMED.APIKey
             -> Maybe EPO.AuthKey
             -> Maybe API.Limit
-            -> DBCmd err (Either API.GetCorpusError DataText)
+            -> DBCmd' env err (Either API.GetCorpusError DataText)
 getDataText (ExternalOrigin api) la q mPubmedAPIKey mAuthKey li = do
   cfg <- view hasConfig
   eRes <- liftBase $ API.get api (_tt_lang la) q mPubmedAPIKey mAuthKey (_gc_epo_api_url cfg) li
@@ -143,12 +144,12 @@ getDataText (InternalOrigin _) la q _ _ _li = do
   ids <-  map fst <$> searchDocInDatabase cId (stem (_tt_lang la) GargPorterAlgorithm $ API.getRawQuery q)
   pure $ Right $ DataOld ids
 
-getDataText_Debug :: (HasNodeError err)
+getDataText_Debug :: (HasNodeError err, HasSettings env)
                   => DataOrigin
                   -> TermType Lang
                   -> API.RawQuery
                   -> Maybe API.Limit
-                  -> DBCmd err ()
+                  -> DBCmd' env err ()
 getDataText_Debug a l q li = do
   result <- getDataText a l q Nothing Nothing li
   case result of
@@ -165,6 +166,7 @@ flowDataText :: forall env err m.
                 , HasTreeError err
                 , HasValidationError err
                 , MonadJobStatus m
+                , HasSettings env
                 )
                 => User
                 -> DataText
@@ -193,7 +195,9 @@ flowAnnuaire :: ( DbCmd' env err m
                 , HasNLPServer env
                 , HasTreeError err
                 , HasValidationError err
-                , MonadJobStatus m )
+                , MonadJobStatus m
+                , HasSettings env
+                )
              => MkCorpusUser
              -> TermType Lang
              -> FilePath
@@ -211,7 +215,9 @@ flowCorpusFile :: ( DbCmd' env err m
                   , HasNLPServer env
                   , HasTreeError err
                   , HasValidationError err
-                  , MonadJobStatus m )
+                  , MonadJobStatus m
+                  , HasSettings env
+                  )
            => MkCorpusUser
            -> Limit -- Limit the number of docs (for dev purpose)
            -> TermType Lang
@@ -240,7 +246,9 @@ flowCorpus :: ( DbCmd' env err m
               , HasTreeError err
               , HasValidationError err
               , FlowCorpus a
-              , MonadJobStatus m )
+              , MonadJobStatus m
+              , HasSettings env
+              )
            => MkCorpusUser
            -> TermType Lang
            -> Maybe FlowSocialListWith
@@ -260,6 +268,7 @@ flow :: forall env err m a c.
         , FlowCorpus a
         , MkCorpus c
         , MonadJobStatus m
+        , HasSettings env
         )
         => Maybe c
         -> MkCorpusUser
@@ -296,6 +305,7 @@ addDocumentsToHyperCorpus :: ( DbCmd' env err m
                              , HasNodeError err
                              , FlowCorpus document
                              , MkCorpus corpus
+                             , HasSettings env
                              )
                              => NLPServerConfig
                              -> Maybe corpus
@@ -309,7 +319,7 @@ addDocumentsToHyperCorpus ncs mb_hyper la corpusId docs = do
   pure ids
 
 ------------------------------------------------------------------------
-createNodes :: ( DbCmd' env err m, HasNodeError err
+createNodes :: ( DbCmd' env err m, HasNodeError err, HasSettings env
                , MkCorpus c
                )
             => MkCorpusUser
@@ -338,6 +348,7 @@ flowCorpusUser :: ( HasNodeError err
                   , HasTreeError err
                   , HasNodeStory env err m
                   , MkCorpus c
+                  , HasSettings env
                   )
                => Lang
                -> User
@@ -367,6 +378,7 @@ buildSocialList :: ( HasNodeError err
                    , HasTreeError err
                    , HasNodeStory env err m
                    , MkCorpus c
+                   , HasSettings env
                    )
                 => Lang
                 -> User
@@ -402,6 +414,7 @@ insertMasterDocs :: ( DbCmd' env err m
                     , HasNodeError err
                     , FlowCorpus a
                     , MkCorpus   c
+                    , HasSettings env
                     )
                  => NLPServerConfig
                  -> Maybe c

src/Gargantext/Database/Action/Node.hs

@@ -21,27 +21,31 @@ module Gargantext.Database.Action.Node
   where
 
 import Control.Lens (view)
+import Data.Text qualified as T
+import Gargantext.API.Admin.Settings.MicroServices
+import Gargantext.API.Admin.Types (settings, _microservicesSettings, HasSettings)
 import Gargantext.Core
+import Gargantext.Core.Config (GargConfig(..))
 import Gargantext.Core.Types (Name)
 import Gargantext.Database.Admin.Types.Hyperdata
 import Gargantext.Database.Admin.Types.Hyperdata.Default
 import Gargantext.Database.Admin.Types.Node
-import Gargantext.Database.Prelude (DBCmd, HasConfig(..))
+import Gargantext.Database.Prelude (HasConfig(..), DBCmd')
 import Gargantext.Database.Query.Table.Node
 import Gargantext.Database.Query.Table.Node.Error
 import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata)
 import Gargantext.Prelude hiding (hash)
-import Gargantext.Prelude.Config (GargConfig(..))
 import Gargantext.Prelude.Crypto.Hash (hash)
+import Servant.Client.Core.BaseUrl
 
 ------------------------------------------------------------------------
 -- | TODO mk all others nodes
-mkNodeWithParent :: (HasNodeError err, HasDBid NodeType)
+mkNodeWithParent :: (HasNodeError err, HasDBid NodeType, HasSettings env)
                  => NodeType
                  -> Maybe ParentId
                  -> UserId
                  -> Name
-                 -> DBCmd err [NodeId]
+                 -> DBCmd' env err [NodeId]
 mkNodeWithParent NodeUser (Just pId) uid  _ = nodeError $ NodeCreationFailed $ UserParentAlreadyExists uid pId
 
 ------------------------------------------------------------------------
@@ -70,12 +74,12 @@ mkNodeWithParent nt (Just pId) uId name  = (:[]) <$> insertNode nt (Just name) N
 
 
 -- | Sugar to create a node, get its NodeId and update its Hyperdata after
-mkNodeWithParent_ConfigureHyperdata :: (HasNodeError err, HasDBid NodeType)
+mkNodeWithParent_ConfigureHyperdata :: (HasNodeError err, HasDBid NodeType, HasSettings env)
                                     => NodeType
                                     -> Maybe ParentId
                                     -> UserId
                                     -> Name
-                                    -> DBCmd err [NodeId]
+                                    -> DBCmd' env err [NodeId]
 mkNodeWithParent_ConfigureHyperdata Notes (Just i) uId name =
   mkNodeWithParent_ConfigureHyperdata' Notes (Just i) uId name
 
@@ -92,14 +96,22 @@ mkNodeWithParent_ConfigureHyperdata NodeFrameNotebook (Just i) uId name = (:[])
 
 mkNodeWithParent_ConfigureHyperdata    _ _ _ _ = nodeError NotImplYet
 
+-- | Creates the base URL for the notes microservices proxy, or defaults
+-- to the notes microservice if the proxy has been disabled from the settings.
+internalNotesProxy :: GargConfig -> MicroServicesSettings -> T.Text
+internalNotesProxy cfg msSettings
+  | _msProxyEnabled msSettings = T.pack $ showBaseUrl proxyUrl <> "/notes"
+  | otherwise                  = _gc_frame_write_url cfg
+  where
+    proxyUrl = mkProxyUrl cfg msSettings
 
 -- | Function not exposed
-mkNodeWithParent_ConfigureHyperdata' :: (HasNodeError err, HasDBid NodeType)
+mkNodeWithParent_ConfigureHyperdata' :: (HasNodeError err, HasDBid NodeType, HasSettings env)
                                      => NodeType
                                      -> Maybe ParentId
                                      -> UserId
                                      -> Name
-                                    -> DBCmd err [NodeId]
+                                     -> DBCmd' env err [NodeId]
 mkNodeWithParent_ConfigureHyperdata' nt (Just i) uId name = do
   nodeId <- case nt of
      Notes -> insertNode Notes (Just name)   Nothing i uId
@@ -108,8 +120,9 @@ mkNodeWithParent_ConfigureHyperdata' nt (Just i) uId name = do
      _              -> nodeError NeedsConfiguration
 
   cfg <- view hasConfig
+  stt <- view settings
   u <- case nt of
-        Notes -> pure $ _gc_frame_write_url cfg
+        Notes -> pure $ internalNotesProxy cfg (_microservicesSettings stt)
         Calc  -> pure $ _gc_frame_calc_url  cfg
         NodeFrameVisio -> pure $ _gc_frame_visio_url  cfg
         _              -> nodeError NeedsConfiguration

src/Gargantext/Database/Action/User/New.hs

@@ -29,23 +29,24 @@ import Control.Lens (view)
 import Control.Monad.Random
 import Data.Text (splitOn)
 import Data.Text qualified as Text
+import Gargantext.API.Admin.Types (HasSettings)
 import Gargantext.Core.Mail
 import Gargantext.Core.Mail.Types (HasMail, mailSettings)
 import Gargantext.Core.Types.Individu
 import Gargantext.Database.Action.Flow (getOrMkRoot)
 import Gargantext.Database.Admin.Types.Node
-import Gargantext.Database.Prelude (Cmd, DBCmd, CmdM)
+import Gargantext.Database.Prelude (Cmd, DBCmd, CmdM, DBCmd')
 import Gargantext.Database.Query.Table.Node.Error (HasNodeError(..), nodeError, NodeError(..))
 import Gargantext.Database.Query.Table.User
 import Gargantext.Prelude
 import Gargantext.Prelude.Crypto.Pass.User (gargPass)
-import Gargantext.Prelude.Mail.Types (MailConfig)
+import Gargantext.Core.Config.Mail (MailConfig)
 import qualified Data.List.NonEmpty as NE
 
 ------------------------------------------------------------------------
 -- | Creates a new 'User' from the input 'EmailAddress', which needs to
 -- be valid (i.e. a valid username needs to be inferred via 'guessUsername').
-newUser :: (CmdM env err m, MonadRandom m, HasNodeError err, HasMail env)
+newUser :: (CmdM env err m, MonadRandom m, HasNodeError err, HasMail env, HasSettings env)
         => EmailAddress
         -> m UserId
 newUser emailAddress = do
@@ -60,9 +61,9 @@ newUser emailAddress = do
 -- This is an internal function and as such it /doesn't/ send out any email
 -- notification, and thus lives in the 'DbCmd' effect stack. You may want to
 -- use 'newUser' instead for standard Gargantext code.
-new_user :: HasNodeError err
+new_user :: (HasNodeError err, HasSettings env)
          => NewUser GargPassword
-         -> DBCmd err UserId
+         -> DBCmd' env err UserId
 new_user rq = do
   (uid NE.:| _) <- new_users (rq NE.:| [])
   pure uid
@@ -72,17 +73,17 @@ new_user rq = do
 -- This is an internal function and as such it /doesn't/ send out any email
 -- notification, and thus lives in the 'DbCmd' effect stack. You may want to
 -- use 'newUsers' instead for standard Gargantext code.
-new_users :: HasNodeError err
+new_users :: (HasNodeError err, HasSettings env)
           => NonEmpty (NewUser GargPassword)
           -- ^ A list of users to create.
-          -> DBCmd err (NonEmpty UserId)
+          -> DBCmd' env err (NonEmpty UserId)
 new_users us = do
   us'   <- liftBase        $ mapM toUserHash us
   void  $ insertUsers      $ NE.map toUserWrite us'
   mapM (fmap fst . getOrMkRoot) $ NE.map  (\u -> UserName   (_nu_username u)) us
 
 ------------------------------------------------------------------------
-newUsers :: (CmdM env err m, MonadRandom m, HasNodeError err, HasMail env)
+newUsers :: (CmdM env err m, MonadRandom m, HasNodeError err, HasMail env, HasSettings env)
          => NonEmpty EmailAddress
          -> m (NonEmpty UserId)
 newUsers us = do
@@ -108,8 +109,8 @@ guessUserName n = case splitOn "@" n of
     _       -> Nothing
 
 ------------------------------------------------------------------------
-newUsers' :: HasNodeError err
-         => MailConfig -> NonEmpty (NewUser GargPassword) -> Cmd err (NonEmpty UserId)
+newUsers' :: (HasNodeError err, HasSettings env)
+         => MailConfig -> NonEmpty (NewUser GargPassword) -> DBCmd' env err (NonEmpty UserId)
 newUsers' cfg us = do
   us' <- liftBase         $ mapM toUserHash  us
   void $ insertUsers      $ NE.map  toUserWrite us'

src/Gargantext/Database/GargDB.hs

@@ -20,7 +20,7 @@ import Data.Text qualified as Text
 import Data.Tuple.Extra (both)
 import Gargantext.Database.Prelude (HasConfig(..))
 import Gargantext.Prelude hiding (hash)
-import Gargantext.Prelude.Config ( gc_datafilepath )
+import Gargantext.Core.Config ( gc_datafilepath )
 import Gargantext.Prelude.Crypto.Hash ( IsHashable(hash) )
 import Prelude qualified
 import System.Directory (createDirectoryIfMissing)

src/Gargantext/Database/Prelude.hs

@@ -32,7 +32,7 @@ import Database.PostgreSQL.Simple.Types (Query(..))
 import Gargantext.Core.Mail.Types (HasMail)
 import Gargantext.Core.NLP (HasNLPServer)
 import Gargantext.Prelude
-import Gargantext.Prelude.Config (GargConfig(), readIniFile', val)
+import Gargantext.Core.Config (GargConfig, readIniFile', val)
 import Opaleye (Unpackspec, showSql, FromFields, Select, runSelect, SqlJsonb, DefaultFromField, toFields, matchMaybe, MaybeFields)
 import Opaleye.Aggregate (countRows)
 import Opaleye.Internal.Constant qualified
@@ -99,6 +99,7 @@ type Cmd'' env err a = forall m.     CmdM''    env err m => m a
 type Cmd'   env err a = forall m.     CmdM'     env err m => m a
 type Cmd        err a = forall m env. CmdM      env err m => m a
 type CmdR       err a = forall m env. CmdRandom env err m => m a
+type DBCmd' env err a = forall m.     DbCmd'    env err m => m a
 type DBCmd      err a = forall m env. DbCmd'    env err m => m a
 
 -- | Only the /minimum/ amount of class constraints required

src/Gargantext/Database/Query/Table/NodeContext.hs

@@ -152,8 +152,53 @@ data ContextForNgramsTerms =
 getContextsForNgramsTerms :: HasNodeError err
                           => NodeId
                           -> [Text]
+                          -> Maybe Bool
                           -> DBCmd err [ContextForNgramsTerms]
-getContextsForNgramsTerms cId ngramsTerms = do
+getContextsForNgramsTerms cId ngramsTerms (Just True) = do
+  let terms_length = length ngramsTerms
+  res <- runPGSQuery query (cId, PGS.In ngramsTerms, terms_length)
+  pure $ (\( _cfnt_nodeId
+           , _cfnt_hash
+           , _cfnt_nodeTypeId
+           , _cfnt_userId
+           , _cfnt_parentId
+           , _cfnt_c_title
+           , _cfnt_date
+           , _cfnt_hyperdata
+           , _cfnt_score
+           , _cfnt_category) -> ContextForNgramsTerms { .. }) <$> res
+  where
+    query :: PGS.Query
+    query = [sql| SELECT t.id, t.hash_id, t.typename, t.user_id, t.parent_id, t.name, t.date, t.hyperdata, t.score, t.category
+                FROM (
+                  SELECT DISTINCT ON (contexts.id)
+                       contexts.id AS id,
+                       hash_id,
+                       typename,
+                       user_id,
+                       parent_id,
+                       name,
+                       date,
+                       hyperdata,
+                       nodes_contexts.score AS score,
+                       nodes_contexts.category AS category --,
+                       -- context_node_ngrams.doc_count AS doc_count
+                    FROM contexts
+                    JOIN context_node_ngrams ON contexts.id = context_node_ngrams.context_id
+                    JOIN nodes_contexts ON contexts.id = nodes_contexts.context_id
+                    JOIN ngrams ON context_node_ngrams.ngrams_id = ngrams.id
+                    WHERE nodes_contexts.node_id = ?
+                     AND ngrams.terms IN ?
+                    GROUP BY
+                      contexts.id,
+                      nodes_contexts.score,
+                      nodes_contexts.category
+                    HAVING COUNT(DISTINCT ngrams.terms) = ?) t
+                   -- ORDER BY t.doc_count DESC
+                   ORDER BY t.score DESC
+                   |]
+
+getContextsForNgramsTerms cId ngramsTerms _ = do
   res <- runPGSQuery query (cId, PGS.In ngramsTerms)
   pure $ (\( _cfnt_nodeId
            , _cfnt_hash

src/Gargantext/Database/Query/Tree/Root.hs

@@ -22,7 +22,7 @@ import Gargantext.Database.Action.User (getUserId, getUsername)
 import Gargantext.Database.Admin.Config ( corpusMasterName, userMaster )
 import Gargantext.Database.Admin.Types.Hyperdata.User ( HyperdataUser )
 import Gargantext.Database.Admin.Types.Node
-import Gargantext.Database.Prelude (runOpaQuery, DBCmd)
+import Gargantext.Database.Prelude (runOpaQuery, DBCmd, DBCmd')
 import Gargantext.Database.Query.Table.Node
 import Gargantext.Database.Query.Table.Node.Error
 import Gargantext.Database.Query.Table.User (queryUserTable, UserPoly(..))
@@ -30,6 +30,7 @@ import Gargantext.Database.Schema.Node (NodePoly(..), NodeRead, queryNodeTable)
 import Gargantext.Prelude
 import Opaleye (restrict, (.==), Select)
 import Opaleye.SqlTypes (sqlStrictText, sqlInt4)
+import Gargantext.API.Admin.Types (HasSettings)
 
 
 getRootId :: (HasNodeError err) => User -> DBCmd err NodeId
@@ -42,9 +43,9 @@ getRootId u = do
 getRoot :: User -> DBCmd err [Node HyperdataUser]
 getRoot = runOpaQuery . selectRoot
 
-getOrMkRoot :: (HasNodeError err)
+getOrMkRoot :: (HasNodeError err, HasSettings env)
             => User
-            -> DBCmd err (UserId, RootId)
+            -> DBCmd' env err (UserId, RootId)
 getOrMkRoot user = do
   userId <- getUserId user
 
@@ -77,10 +78,10 @@ userFromMkCorpusUser (MkCorpusUserNormalCorpusIds u _cids) = u
 userFromMkCorpusUser (MkCorpusUserNormalCorpusName u _cname) = u
 
 
-getOrMkRootWithCorpus :: (HasNodeError err, MkCorpus a)
+getOrMkRootWithCorpus :: (HasNodeError err, MkCorpus a, HasSettings env)
                       => MkCorpusUser
                       -> Maybe a
-                      -> DBCmd err (UserId, RootId, CorpusId)
+                      -> DBCmd' env err (UserId, RootId, CorpusId)
 getOrMkRootWithCorpus MkCorpusUserMaster c = do
   (userId, rootId) <- getOrMkRoot (UserName userMaster)
   corpusId'' <- do
@@ -119,9 +120,9 @@ mkCorpus cName c rootId userId = do
   pure (userId, rootId, corpusId)
 
 
-mkRoot :: HasNodeError err
+mkRoot :: (HasNodeError err, HasSettings env)
        => User
-       -> DBCmd err [RootId]
+       -> DBCmd' env err [RootId]
 mkRoot user = do
 
   -- TODO

stack.yaml

@@ -62,6 +62,10 @@
   git: "https://github.com/MercuryTechnologies/ekg-json.git"
   subdirs:
   - .
+- commit: c90b7bc55b0e628d0b71ccee4e222833a19792f8
+  git: "https://github.com/adinapoli/http-reverse-proxy.git"
+  subdirs:
+  - .
 - commit: 7533a9ccd3bfe77141745f6b61039a26aaf5c83b
   git: "https://github.com/adinapoli/llvm-hs.git"
   subdirs:
@@ -102,6 +106,10 @@
   git: "https://github.com/delanoe/patches-map"
   subdirs:
   - .
+- commit: 7694f62af6bc1596d754b42af16da131ac403b3a
+  git: "https://github.com/fpringle/servant-routes.git"
+  subdirs:
+  - .
 - commit: 4fd2edf30c141600ffad6d730cc4c1c08a6dbce4
   git: "https://github.com/robstewart57/rdf4h.git"
   subdirs:
@@ -118,7 +126,7 @@
   git: "https://gitlab.iscpif.fr/gargantext/crawlers/epo-proxy-api.git"
   subdirs:
   - .
-- commit: 3a7d039e07c8564e8ff84ef88480924d18aa5018
+- commit: 3665ccda54893d01bb27220538eefdde0c1e7419
   git: "https://gitlab.iscpif.fr/gargantext/crawlers/hal.git"
   subdirs:
   - .
@@ -142,7 +150,7 @@
   git: "https://gitlab.iscpif.fr/gargantext/gargantext-graph.git"
   subdirs:
   - .
-- commit: d4f9bee483d41bbdf8ab4e09efb5a5a8216edff4
+- commit: bb15d828d5ef36eeaa84cccb00598b585048c88e
   git: "https://gitlab.iscpif.fr/gargantext/haskell-gargantext-prelude"
   subdirs:
   - .
@@ -308,8 +316,7 @@ flags:
   "full-text-search":
     "build-search-demo": false
   gargantext:
-    "disable-db-obfuscation-executable": false
-    "no-phylo-debug-logs": false
+    "no-phylo-debug-logs": true
     "test-crypto": false
   "ghc-lib-parser":
     "threaded-rts": true

test-data/gargantext-settings.toml

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

test/Test/API/Routes.hs

@@ -39,7 +39,6 @@ mkUrl _port urlPiece =
 clientRoutes :: API (AsClientT ClientM)
 clientRoutes = genericClient
 
-
 -- This is for Servant.Client requests
 auth_api :: AuthRequest -> ClientM AuthResponse
 auth_api = clientRoutes & apiWithCustomErrorScheme

test/Test/API/Setup.hs

@@ -3,7 +3,8 @@
 
 module Test.API.Setup where
 
--- import Gargantext.Prelude (printDebug)
+import Control.Concurrent.Async qualified as Async
+import Control.Concurrent.MVar
 import Control.Lens
 import Control.Monad.Reader
 import Gargantext.API (makeApp)
@@ -12,6 +13,9 @@ import Gargantext.API.Admin.Settings
 import Gargantext.API.Admin.Types
 import Gargantext.API.Errors.Types
 import Gargantext.API.Prelude
+import Gargantext.Core.Config
+import Gargantext.Core.Config.Mail qualified as Mail
+import Gargantext.Core.Config.NLP qualified as NLP
 import Gargantext.Core.NLP
 import Gargantext.Core.NodeStory
 import Gargantext.Core.Types.Individu
@@ -23,9 +27,7 @@ import Gargantext.Database.Admin.Types.Hyperdata
 import Gargantext.Database.Prelude
 import Gargantext.Database.Query.Table.Node (getOrMkList)
 import Gargantext.Database.Query.Tree.Root (MkCorpusUser(..))
-import Gargantext.Prelude.Config
-import Gargantext.Prelude.Mail qualified as Mail
-import Gargantext.Prelude.NLP qualified as NLP
+import Gargantext.MicroServices.ReverseProxy (microServicesProxyApp)
 import Gargantext.System.Logging
 import Gargantext.Utils.Jobs qualified as Jobs
 import Gargantext.Utils.Jobs.Monad qualified as Jobs
@@ -33,20 +35,25 @@ import Gargantext.Utils.Jobs.Queue qualified as Jobs
 import Gargantext.Utils.Jobs.Settings qualified as Jobs
 import Network.HTTP.Client.TLS (newTlsManager)
 import Network.Wai (Application)
+import Network.Wai.Handler.Warp (runSettingsSocket)
 import Network.Wai.Handler.Warp qualified as Warp
+import Network.Wai.Handler.Warp.Internal
 import Prelude
 import Servant.Auth.Client ()
 import Servant.Client
 import Servant.Job.Async qualified as ServantAsync
-import Test.Database.Setup (withTestDB, fakeIniPath, testEnvToPgConnectionInfo)
+import Test.Database.Setup (withTestDB, fakeIniPath, testEnvToPgConnectionInfo, fakeSettingsPath)
 import Test.Database.Types
+import qualified UnliftIO
+import Data.Streaming.Network (bindPortTCP)
 
 
 newTestEnv :: TestEnv -> Logger (GargM Env BackendInternalError) -> Warp.Port -> IO Env
 newTestEnv testEnv logger port = do
   file          <- fakeIniPath
+  settingsP     <- SettingsFile <$> fakeSettingsPath
   !manager_env  <- newTlsManager
-  !settings'    <- devSettings devJwkFile <&> appPort .~ port
+  !settings'    <- devSettings devJwkFile settingsP <&> appPort .~ port
 
   !config_env    <- readConfig file
   prios          <- withLogger () $ \ioLogger -> Jobs.readPrios ioLogger (file <> ".jobs")
@@ -80,18 +87,33 @@ newTestEnv testEnv logger port = do
     , _env_nlp       = nlp_env
     }
 
-withGargApp :: Application -> (Warp.Port -> IO ()) -> IO ()
-withGargApp app action = do
-  Warp.testWithApplication (pure app) action
-
+-- | Run the gargantext server on a random port, picked by Warp, which allows
+-- for concurrent tests to be executed in parallel, if we need to.
 withTestDBAndPort :: (((TestEnv, Warp.Port), Application) -> IO ()) -> IO ()
 withTestDBAndPort action =
   withTestDB $ \testEnv -> do
     app <- withLoggerHoisted Mock $ \ioLogger -> do
              env <- newTestEnv testEnv ioLogger 8080
              makeApp env
-    withGargApp app $ \port ->
-      action ((testEnv, port), app)
+    Warp.testWithApplication (pure app) $ \port -> action ((testEnv, port), app)
+
+-- | Starts the backend server /and/ the microservices proxy, the former at
+-- a random port, the latter at a predictable port.
+withBackendServerAndProxy :: (((TestEnv, Warp.Port, Warp.Port)) -> IO ()) -> IO ()
+withBackendServerAndProxy action =
+  withTestDB $ \testEnv -> do
+    gargApp <- withLoggerHoisted Mock $ \ioLogger -> do
+                 env <- newTestEnv testEnv ioLogger 8080
+                 makeApp env
+    proxyApp <- withLoggerHoisted Mock $ \ioLogger -> do
+                  env <- newTestEnv testEnv ioLogger 8080
+                  pure $ microServicesProxyApp env
+
+    Warp.testWithApplication (pure gargApp) $ \serverPort ->
+      testWithApplicationOnPort (pure proxyApp) proxyPort $
+        action (testEnv, serverPort, proxyPort)
+  where
+    proxyPort = 8090
 
 setupEnvironment :: TestEnv -> IO ()
 setupEnvironment env = flip runReaderT env $ runTestMonad $ do
@@ -113,3 +135,40 @@ createAliceAndBob testEnv = do
 
     void $ new_user nur1
     void $ new_user nur2
+
+
+-- | A version of 'withApplication' that allows supplying a user-specified port
+-- so that we are sure that our garg apps will run on the same port as specified
+-- in the 'Env' settings.
+testWithApplicationOnPort :: IO Application -> Warp.Port -> IO a -> IO a
+testWithApplicationOnPort mkApp userPort action = do
+    app <- mkApp
+    started <- mkWaiter
+    let appSettings =
+            Warp.defaultSettings
+                { settingsBeforeMainLoop =
+                    notify started () >> settingsBeforeMainLoop Warp.defaultSettings
+                , settingsPort = userPort
+                }
+    sock <- bindPortTCP userPort "127.0.0.1"
+    result <-
+        Async.race
+            (runSettingsSocket appSettings sock app)
+            (waitFor started >> action)
+    case result of
+        Left () -> UnliftIO.throwString "Unexpected: runSettingsSocket exited"
+        Right x -> return x
+
+data Waiter a = Waiter
+    { notify :: a -> IO ()
+    , waitFor :: IO a
+    }
+
+mkWaiter :: IO (Waiter a)
+mkWaiter = do
+    mvar <- newEmptyMVar
+    return
+        Waiter
+            { notify = putMVar mvar
+            , waitFor = readMVar mvar
+            }

test/Test/Database/Setup.hs

@@ -2,6 +2,7 @@
 module Test.Database.Setup (
     withTestDB
   , fakeIniPath
+  , fakeSettingsPath
   , testEnvToPgConnectionInfo
   ) where
 
@@ -15,9 +16,10 @@ import Database.PostgreSQL.Simple.Options qualified as Client
 import Database.PostgreSQL.Simple.Options qualified as Opts
 import Database.Postgres.Temp qualified as Tmp
 import Gargantext.API.Admin.EnvTypes (Mode(Mock))
+import Gargantext.API.Admin.Settings
 import Gargantext.Core.NodeStory (fromDBNodeStoryEnv)
 import Gargantext.Prelude
-import Gargantext.Prelude.Config
+import Gargantext.Core.Config
 import Gargantext.System.Logging (withLoggerHoisted)
 import Paths_gargantext
 import Prelude qualified
@@ -34,6 +36,9 @@ dbName = "gargandb_test"
 fakeIniPath :: IO FilePath
 fakeIniPath = getDataFileName "test-data/test_config.ini"
 
+fakeSettingsPath :: IO FilePath
+fakeSettingsPath = getDataFileName "test-data/gargantext-settings.toml"
+
 gargDBSchema :: IO FilePath
 gargDBSchema = getDataFileName "devops/postgres/schema.sql"
 
@@ -73,12 +78,15 @@ setup = do
       bootstrapDB db pool gargConfig
       ugen <- emptyCounter
       test_nodeStory <- fromDBNodeStoryEnv pool
+      stgs <- devSettings devJwkFile =<< (SettingsFile <$> fakeSettingsPath)
       withLoggerHoisted Mock $ \logger -> do
         pure $ TestEnv { test_db = DBHandle pool db
                        , test_config = gargConfig
                        , test_nodeStory
                        , test_usernameGen = ugen
-                       , test_logger = logger }
+                       , test_logger = logger
+                       , test_settings = stgs
+                       }
 
 withTestDB :: (TestEnv -> IO ()) -> IO ()
 withTestDB = bracket setup teardown

test/Test/Offline/Phylo.hs

@@ -5,7 +5,7 @@
 
 module Test.Offline.Phylo (tests) where
 
-import Common
+import CLI.Phylo.Common
 import Data.Aeson as JSON
 import Data.Aeson.Types qualified as JSON
 import Data.GraphViz.Attributes.Complete qualified as Graphviz