Merge branch 'dev' into 242-dev-phylo-websearch

.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.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
+
+## Version 0.0.7.1.6.4
+
+* [FRONT][FIX][[Corpus] Import docs from selected list is broken (#679)](https://gitlab.iscpif.fr/gargantext/purescript-gargantext/issues/679)
+* [BACK][FIX][[Node terms] institutes missing with HAL request (#330)](https://gitlab.iscpif.fr/gargantext/haskell-gargantext/issues/330)
+
 ## Version 0.0.7.1.6.3
 
 * [BACK][FIX][CSV; TSV in all codebase (#348)](https://gitlab.iscpif.fr/gargantext/haskell-gargantext/issues/348)

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.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 mails) = do
+  withDevEnv iniPath $ \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
+  <$> ( strOption ( long "ini-path"
+                    <> metavar "FILEPATH"
+                    <> help "Location of the .ini path"
+                    ) )
+  <*> ( 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,13 @@ 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.Types
 import Gargantext.API.Admin.EnvTypes (DevEnv(..), DevJobHandle(..))
 import Gargantext.API.Dev (withDevEnv, runCmdGargDev)
 import Gargantext.API.Errors.Types ( BackendInternalError )
@@ -23,66 +26,62 @@ 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.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 qualified Data.Text as T
+import Prelude (String)
+import Gargantext.Core.Types.Query
 
 
-main :: IO ()
-main = do
-  [fun, user, name, iniPath, limit, corpusPath] <- getArgs
-
-  --{-
-
+importCLI :: ImportArgs -> IO ()
+importCLI (ImportArgs fun user name iniPath 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 $ \env -> do
-    _ <- if fun == "corpus"
-          then runCmdGargDev env corpus
-          else pure 0 --(cs "false")
+    void $ case fun of
+      IF_corpus
+        -> runCmdGargDev env corpus
+      IF_corpusTsvHal
+        -> runCmdGargDev env corpusTsvHal
+      IF_annuaire
+        -> runCmdGargDev env annuaire
+
+importCmd :: HasCallStack => Mod CommandFields CLI
+importCmd = command "import" (info (helper <*> fmap CLISub import_p) (progDesc "Import CLI."))
+
+renderImportFunction :: ImportFunction -> T.Text
+renderImportFunction = T.drop 3 . T.pack . show
 
-    _ <- if fun == "corpusTsvHal"
-          then runCmdGargDev env corpusTsvHal
-          else pure 0 --(cs "false")
+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") )
+  <*> ( option str ( long "ini" <> help "Path to the .ini file.") )
+  <*> (fmap Limit ( option auto ( long "ini" <> metavar "INT" <> help "The limit for the query") ))
+  <*> ( option str ( long "corpus-path" <> help "Path to corpus file") )
 
-    _ <- 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 ()
+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 Data.List.NonEmpty qualified as NE
 import Gargantext.API.Dev (withDevEnv, runCmdDev)
@@ -24,22 +24,20 @@ 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.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 Gargantext.API.Admin.Types
+import Gargantext.Database.Prelude (DBCmd')
+import CLI.Types
+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) = do
   putStrLn ("Enter master user (gargantua) _password_ :" :: Text)
   password  <- getLine
 
@@ -49,18 +47,18 @@ main = do
   cfg       <- readConfig         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
@@ -75,4 +73,13 @@ main = do
     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
+  <$> ( strOption ( long "ini-path"
+                    <> metavar "FILEPATH"
+                    <> help "Location of the .ini path"
+                    ) )

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.Types
+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.NLP (HasNLPServer)
 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 ()
+import Options.Applicative
+import Prelude (String)
+import Gargantext.Core.Types
 
+invitationsCLI :: InvitationsArgs -> IO ()
+invitationsCLI (InvitationsArgs iniPath user node_id email) = do
   _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)
+  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 $ \env -> do
-    _ <- runCmdDev env invite
-    pure ()
+    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
+  <$> ( strOption ( long "ini-path"
+                    <> metavar "FILEPATH"
+                    <> help "Location of the .ini path"
+                    ) )
+  <*> ( 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"
@@ -71,17 +66,9 @@ args = Args
   <*> ( strOption ( long "db-password"
                     <> 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
@@ -101,7 +88,7 @@ main = do
 obfuscateNotes :: PSQL.Connection -> IO ()
 obfuscateNotes c = do
   let nt = toDBid Notes
-  
+
   _ <- runPGSExecute c [sql|UPDATE nodes SET name = concat('notes-', id) WHERE typename = ?;|] (PSQL.Only nt)
 
   nsNew <- runPGSQuery c [sql|SELECT id, name FROM nodes WHERE typename = ?|] (PSQL.Only nt) :: IO [(Int, Text)]

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

+
+module CLI.Types where
+
+import Data.String
+import Data.Text (Text)
+import Gargantext.Core.Types.Query
+import Prelude
+import Gargantext.Core.Types (NodeId)
+
+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 :: !FilePath
+  , 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      :: !FilePath
+  , imp_limit    :: !Limit
+  , imp_corpus_path :: !FilePath
+  } deriving (Show, Eq)
+
+data InitArgs = InitArgs
+  { init_ini :: !FilePath
+  } deriving (Show, Eq)
+
+data InvitationsArgs = InvitationsArgs
+  { inv_path    :: !FilePath
+  , 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 :: !FilePath
+  } deriving (Show, Eq)
+
+data GoldenFileDiffArgs = GoldenFileDiffArgs
+  { gdf_expected :: !FilePath
+  , gdf_actual   :: !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
+  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,26 @@ 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 Data.List qualified as List (cycle, concat, take, unlines)
 import Gargantext.API.Dev (withDevEnv)
 import Gargantext.API.Node () -- instances only
 import Gargantext.Prelude
 import Gargantext.Prelude.Config (GargConfig(..), readConfig)
 import Prelude qualified
+import Options.Applicative
 
-main :: IO ()
-main = do
+upgradeCLI :: UpgradeArgs -> IO ()
+upgradeCLI (UpgradeArgs iniPath) = do
 
   let ___ = putStrLn ((List.concat
                        $ List.take 72
@@ -34,11 +36,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."
@@ -92,3 +89,13 @@ 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
+  <$> ( strOption ( long "ini-path"
+                    <> metavar "FILEPATH"
+                    <> help "Location of the .ini path"
+                    ) )

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,69 @@ 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)
-
-------------------------------------------------------------------------
--- 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]
+import Prelude
+
+import CLI.FilterTermsAndCooc
+import CLI.ObfuscateDB (obfuscateDB, obfuscateDBCmd)
+import CLI.Types
+import Options.Applicative
+import CLI.Admin (adminCLI, adminCmd)
+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.Upgrade (upgradeCLI, upgradeCmd)
+import CLI.FileDiff (fileDiffCLI, fileDiffCmd)
+
+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
 
 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
+                 )

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/metrics/histo/users.sql

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

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="75954432d1b867597b6eff606d22b36e53a18b283464c9c9d309af231a694d6b"
-expected_cabal_project_freeze_hash="09930a2fa36e4325d46e5d069595d300c6017472f405f8ac67158377816d132a"
+expected_cabal_project_hash="22167800d98d4f204c85c49420eaee0618e749062b9ae9709719638e54319ae9"
+expected_cabal_project_freeze_hash="7bb3ba71d0a1881a5c4fd420b9988155586e0cf51e9b6d55867bce3d311d59a5"
 
 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: b99b9e568c8bdc73af2b8016ed03ba5ee83c2030
+    tag: 3a7d039e07c8564e8ff84ef88480924d18aa5018
 
 source-repository-package
     type: git
@@ -165,7 +165,12 @@ source-repository-package
     type: git
     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
+
 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,
@@ -453,8 +454,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,

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

gargantext.cabal

@@ -5,7 +5,7 @@ cabal-version: 3.4
 -- see: https://github.com/sol/hpack
 
 name:           gargantext
-version: 0.0.7.1.6.3
+version: 0.0.7.1.7.2
 synopsis:       Search, map, share
 description:    Please see README.md
 category:       Data
@@ -34,7 +34,7 @@ data-files:
     ekg-assets/cross.png
     test-data/ngrams/GarganText_NgramsTerms-QuantumComputing.json
     test-data/ngrams/simple.json
-    test-data/ngrams/simple.csv
+    test-data/ngrams/simple.tsv
     test-data/phylo/bpa_phylo_test.json
     test-data/phylo/cleopatre.golden.json
     test-data/phylo/nadal.golden.json
@@ -49,7 +49,7 @@ data-files:
     test-data/phylo/phylo2dot2json.golden.json
     test-data/stemming/lancaster.txt
     test-data/test_config.ini
-    gargantext-cors-settings.toml
+    gargantext-settings.toml
     .clippy.dhall
 
 -- common options
@@ -81,7 +81,7 @@ common optimized
     -rtsopts
     -with-rtsopts=-N
     -Wmissing-signatures
-  
+
 -- When enabled, it swaps the hashing algorithm
 -- with a quicker (and less secure) version, which
 -- runs faster in tests.
@@ -89,10 +89,6 @@ flag test-crypto
   default: False
   manual: True
 
-flag disable-db-obfuscation-executable
-  default: False
-  manual: True
-
 -- When enabled, it suppresses at compile time the
 -- debug output for the phylo code, so that it doesn't
 -- hinder its performance.
@@ -111,6 +107,8 @@ library
       Gargantext.API.Admin.Orchestrator.Types
       Gargantext.API.Admin.Settings
       Gargantext.API.Admin.Settings.CORS
+      Gargantext.API.Admin.Settings.MicroServices
+      Gargantext.API.Admin.Settings.TOML
       Gargantext.API.Admin.Types
       Gargantext.API.Auth.PolicyCheck
       Gargantext.API.Count.Types
@@ -253,6 +251,7 @@ library
       Gargantext.Database.Schema.Node
       Gargantext.Database.Schema.User
       Gargantext.Defaults
+      Gargantext.MicroServices.ReverseProxy
       Gargantext.System.Logging
       Gargantext.Utils.Dict
       Gargantext.Utils.Jobs
@@ -565,6 +564,7 @@ library
     , http-conduit ^>= 2.3.8
     , http-media ^>= 0.8.0.0
     , http-types ^>= 0.12.3
+    , http-reverse-proxy >= 0.6.1.0
     , hxt ^>= 9.3.1.22
     , ihaskell >= 0.11.0.0
     -- necessary for ihaskell to build
@@ -617,7 +617,10 @@ library
     , quickcheck-instances ^>= 0.3.25.2
     , rake ^>= 0.0.1
     , random ^>= 1.2.1
+    , raw-strings-qq
     , rdf4h ^>= 3.1.1
+    , recover-rtti >= 0.4 && < 0.5
+    , regex
     , regex-compat ^>= 0.95.2.1
     , regex-tdfa ^>= 1.3.1.2
     , replace-attoparsec ^>= 1.4.5.0
@@ -689,144 +692,29 @@ library
     , zip-archive ^>= 0.4.3
     , zlib ^>= 0.6.2.3
 
-executable gargantext-admin
-  import:
-      defaults
-    , optimized
-  main-is: Main.hs
-  other-modules:
-      Paths_gargantext
-  hs-source-dirs:
-      bin/gargantext-admin
-  build-depends:
-      extra
-    , gargantext
-    , gargantext-prelude
-    , text
-
 executable gargantext-cli
   import:
       defaults
     , optimized
   main-is: Main.hs
   other-modules:
-      CleanCsvCorpus
+      CLI.Admin
+      CLI.CleanCsvCorpus
+      CLI.FileDiff
+      CLI.FilterTermsAndCooc
+      CLI.Import
+      CLI.Init
+      CLI.Invitations
+      CLI.ObfuscateDB
+      CLI.Phylo
+      CLI.Phylo.Common
+      CLI.Phylo.Profile
+      CLI.Types
+      CLI.Upgrade
+      CLI.Utils
       Paths_gargantext
   hs-source-dirs:
       bin/gargantext-cli
-  build-depends:
-      aeson ^>= 1.5.6.0
-    , async ^>= 2.2.4
-    , bytestring ^>= 0.10.12.0
-    , cassava ^>= 0.5.2.0
-    , containers ^>= 0.6.5.1
-    , extra ^>= 1.7.9
-    , full-text-search ^>= 0.2.1.4
-    , gargantext
-    , gargantext-prelude
-    , ini ^>= 0.4.1
-    , optparse-generic ^>= 1.4.7
-    , protolude ^>= 0.3.3
-    , split ^>= 0.2.3.4
-    , text ^>= 1.2.4.1
-    , unordered-containers ^>= 0.2.16.0
-    , vector ^>= 0.12.3.0
-
-executable gargantext-db-obfuscation
-  import:
-      defaults
-    , optimized
-  main-is: Main.hs
-  other-modules:
-      Paths_gargantext
-  hs-source-dirs:
-      bin/gargantext-db-obfuscation
-  if flag(disable-db-obfuscation-executable)
-    buildable: False
-  else
-    build-depends:
-        extra
-      , gargantext
-      , gargantext-prelude
-      , optparse-simple
-      , postgresql-simple ^>= 0.6.4
-      , text
-
-executable gargantext-import
-  import:
-      defaults
-    , optimized
-  main-is: Main.hs
-  default-extensions:
-    TypeOperators
-  other-modules:
-      Paths_gargantext
-  hs-source-dirs:
-      bin/gargantext-import
-  build-depends:
-      extra ^>= 1.7.9
-    , gargantext
-    , gargantext-prelude
-    , servant-server ^>= 0.18.3
-    , text ^>= 1.2.4.1
-
-executable gargantext-init
-  import:
-      defaults
-    , optimized
-  main-is: Main.hs
-  other-modules:
-      Paths_gargantext
-  hs-source-dirs:
-      bin/gargantext-init
-  build-depends:
-      cron ^>= 0.7.0
-    , extra ^>= 1.7.9
-    , gargantext
-    , gargantext-prelude
-    , text ^>= 1.2.4.1
-
-executable gargantext-invitations
-  import:
-      defaults
-    , optimized
-  main-is: Main.hs
-  other-modules:
-      Paths_gargantext
-  hs-source-dirs:
-      bin/gargantext-invitations
-  build-depends:
-      extra ^>= 1.7.9
-    , gargantext
-    , gargantext-prelude
-    , text ^>= 1.2.4.1
-
-executable gargantext-phylo
-  import:
-      defaults
-    , optimized
-  main-is: Main.hs
-  other-modules:
-      Paths_gargantext
-      Common
-  hs-source-dirs:
-      bin/gargantext-phylo bin/gargantext-phylo/Phylo
-  default-extensions:
-      DataKinds
-      DeriveGeneric
-      FlexibleContexts
-      FlexibleInstances
-      GADTs
-      GeneralizedNewtypeDeriving
-      ImportQualifiedPost
-      MultiParamTypeClasses
-      NamedFieldPuns
-      NoImplicitPrelude
-      OverloadedStrings
-      RankNTypes
-      RecordWildCards
-      StrictData
-  ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N -O2 -Wmissing-signatures
   build-depends:
       aeson ^>= 1.5.6.0
     , async ^>= 2.2.4
@@ -836,14 +724,20 @@ executable gargantext-phylo
     , cryptohash ^>= 0.11.9
     , directory ^>= 1.3.6.0
     , extra ^>= 1.7.9
+    , full-text-search ^>= 0.2.1.4
     , gargantext
     , gargantext-prelude
     , ini ^>= 0.4.1
+    , optparse-applicative
     , optparse-generic ^>= 1.4.7
     , parallel ^>= 3.2.2.0
+    , postgresql-simple ^>= 0.6.4
+    , protolude ^>= 0.3.3
+    , shelly
     , split ^>= 0.2.3.4
     , text ^>= 1.2.4.1
     , time ^>= 1.9.3
+    , tree-diff
     , unordered-containers ^>= 0.2.16.0
     , vector ^>= 0.7.3
 
@@ -870,23 +764,6 @@ executable gargantext-server
     , unordered-containers ^>= 0.2.16.0
     , vector ^>= 0.7.3
 
-executable gargantext-upgrade
-  import:
-      defaults
-    , optimized
-  main-is: Main.hs
-  other-modules:
-      Paths_gargantext
-  hs-source-dirs:
-      bin/gargantext-upgrade
-  build-depends:
-      cron ^>= 0.7.0
-    , extra ^>= 1.7.9
-    , gargantext
-    , gargantext-prelude
-    , postgresql-simple ^>= 0.6.4
-    , text ^>= 1.2.4.1
-
 test-suite garg-test-tasty
   import:
     defaults
@@ -894,7 +771,7 @@ test-suite garg-test-tasty
   main-is: drivers/tasty/Main.hs
   other-modules:
       Test.API.Routes
-      Common
+      CLI.Phylo.Common
       Test.API.Setup
       Test.Core.Similarity
       Test.Core.Text
@@ -930,7 +807,7 @@ test-suite garg-test-tasty
       Test.Utils.Jobs
       Paths_gargantext
   hs-source-dirs:
-      test bin/gargantext-phylo/Phylo
+      test bin/gargantext-cli
   ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N
   build-depends:
       QuickCheck ^>= 2.14.2
@@ -1108,39 +985,3 @@ benchmark garg-bench
   ghc-options:   "-with-rtsopts=-T -A32m"
   if impl(ghc >= 8.6)
     ghc-options: "-with-rtsopts=--nonmoving-gc"
-
-executable gargantext-phylo-profile
-  main-is: Main.hs
-  other-modules:
-      Paths_gargantext
-      Common
-  hs-source-dirs:
-      bin/gargantext-phylo-profile bin/gargantext-phylo/Phylo
-  ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N -O2 -Wmissing-signatures
-  build-depends:
-      base
-    , bytestring
-    , gargantext
-    , gargantext-prelude
-    , shelly
-    , text
-    , async
-    , cryptohash
-    , aeson
-    , split
-    , vector
-    , directory
-  default-language: GHC2021
-
-executable garg-golden-file-diff
-  import:
-      defaults
-    , optimized
-  main-is: Main.hs
-  hs-source-dirs:
-      bin/gargantext-golden-file-diff
-  build-depends:
-      base
-    , text
-    , tree-diff
-  default-language: Haskell2010

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)
@@ -45,13 +46,15 @@ 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.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)
@@ -68,12 +71,17 @@ import System.FilePath
 startGargantext :: Mode -> PortNumber -> FilePath -> IO ()
 startGargantext mode port file = withLoggerHoisted mode $ \logger -> do
   env <- newEnv logger port file
+  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`
@@ -84,14 +92,15 @@ startGargantext mode port file = withLoggerHoisted mode $ \logger -> do
               "You must run 'gargantext-init " <> pack file <>
               "' 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

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
@@ -52,15 +51,17 @@ import Servant.Job.Async (newJobEnv, defaultSettings)
 import System.Directory
 import System.IO (hClose)
 import System.IO.Temp (withTempFile)
+import qualified Data.Pool as Pool
 
 devSettings :: FilePath -> IO Settings
 devSettings jwkFile = do
   jwkExists <- doesFileExist jwkFile
   when (not jwkExists) $ writeKey jwkFile
   jwk       <- readKey jwkFile
-  gargCorsSettings <- loadGargCorsSettings
+  GargTomlSettings{..} <- loadGargTomlSettings
   pure $ Settings
-    { _corsSettings = gargCorsSettings
+    { _corsSettings = _gargCorsSettings
+    , _microservicesSettings = _gargMicroServicesSettings
     , _appPort = 3000
     , _logLevelLimit = LevelDebug
 --    , _dbServer = "localhost"

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)
-                                 <*> 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) }
-
+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
 
 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.Prelude.Config
+import Servant.Client.Core.BaseUrl
+import Toml
+
+data MicroServicesSettings =
+  MicroServicesSettings {
+    -- | The port where the microservices proxy will be listening on.
+    _msProxyPort :: Int
+  } deriving (Show, Eq)
+
+microServicesSettingsCodec :: TomlCodec MicroServicesSettings
+microServicesSettingsCodec = MicroServicesSettings
+  <$> Toml.int "proxy-port" .= _msProxyPort
+
+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 Paths_gargantext
+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" .= _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 :: IO GargTomlSettings
+loadGargTomlSettings = do
+  tomlFile <- getDataFileName "gargantext-settings.toml"
+  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
@@ -19,15 +20,16 @@ data SendEmailType = SendEmailViaAws
     deriving (Show, Read, Enum, Bounded, Generic)
 
 data Settings = Settings
-    { _corsSettings    :: !CORSSettings   -- CORS settings
-    , _appPort         :: !PortNumber
-    , _logLevelLimit   :: !LogLevel -- log level from the monad-logger package
+    { _corsSettings          :: !CORSSettings   -- CORS settings
+    , _microservicesSettings :: !MicroServicesSettings
+    , _appPort               :: !PortNumber
+    , _logLevelLimit         :: !LogLevel -- log level from the monad-logger package
 --    , _dbServer        :: Text
 --    ^ this is not used yet
-    , _jwtSettings     :: !JWTSettings
-    , _cookieSettings  :: !CookieSettings
-    , _sendLoginEmails :: !SendEmailType
-    , _scrapydUrl      :: !BaseUrl
+    , _jwtSettings           :: !JWTSettings
+    , _cookieSettings        :: !CookieSettings
+    , _sendLoginEmails       :: !SendEmailType
+    , _scrapydUrl            :: !BaseUrl
     }
 
 makeLenses ''Settings

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

@@ -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

@@ -48,6 +48,7 @@ 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/Routes/Named/Private.hs

@@ -13,11 +13,15 @@ module Gargantext.API.Routes.Named.Private (
   , NodeAPIEndpoint(..)
   , MembersAPI(..)
   , IsGenericNodeRoute(..)
+  , NotesProxy(..)
   ) where
 
 
+import Data.Kind
 import Data.Text (Text)
+import Data.Text qualified as T
 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 +29,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
@@ -96,6 +98,12 @@ data GargPrivateAPI' mode = GargPrivateAPI'
   } deriving Generic
 
 
+data NotesProxy mode = NotesProxy
+  { noteProxyEp :: mode :- Capture "frameId" T.Text
+                        :> Raw
+  } deriving Generic
+
+
 data GargAdminAPI mode = GargAdminAPI
   { rootsEp       :: mode :- "user"  :> Summary "First user endpoint" :> NamedRoutes Roots
   , adminNodesAPI :: mode :- "nodes" :> Summary "Nodes endpoint"

src/Gargantext/API/Server/Named.hs

@@ -31,15 +31,15 @@ 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/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/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/Core/Viz/Phylo.hs

@@ -45,6 +45,8 @@ data CorpusParser =
       Wos  {_wos_limit  :: Int}
     | Tsv  {_tsv_limit  :: Int}
     | Tsv' {_tsv'_limit :: Int}
+    | Csv  {_csv_limit  :: Int}
+    | Csv' {_csv'_limit :: Int}
     deriving (Show,Generic,Eq, ToExpr)
 
 instance ToSchema CorpusParser where
@@ -727,6 +729,8 @@ instance Arbitrary CorpusParser where
   arbitrary = oneof [ Wos <$> arbitrary
                     , Tsv <$> arbitrary
                     , Tsv' <$> arbitrary
+                    , Csv <$> arbitrary
+                    , Csv' <$> arbitrary
                     ]
 
 instance Arbitrary ListParser where

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)
@@ -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.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,16 @@ mkNodeWithParent_ConfigureHyperdata NodeFrameNotebook (Just i) uId name = (:[])
 
 mkNodeWithParent_ConfigureHyperdata    _ _ _ _ = nodeError NotImplYet
 
+internalNotesProxy :: BaseUrl -> T.Text
+internalNotesProxy proxyUrl = T.pack $ showBaseUrl proxyUrl <> "/notes"
 
 -- | Function not exposed
-mkNodeWithParent_ConfigureHyperdata' :: (HasNodeError err, HasDBid NodeType)
-                                    => NodeType
-                                    -> Maybe ParentId
-                                    -> UserId
-                                    -> Name
-                                    -> DBCmd err [NodeId]
+mkNodeWithParent_ConfigureHyperdata' :: (HasNodeError err, HasDBid NodeType, HasSettings env)
+                                     => NodeType
+                                     -> Maybe ParentId
+                                     -> UserId
+                                     -> Name
+                                     -> 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 +114,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 (mkProxyUrl 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,12 +29,13 @@ 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
@@ -45,7 +46,7 @@ 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/Prelude.hs

@@ -95,11 +95,12 @@ type CmdRandom env err m =
   , HasMail           env
   )
 
-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     err a = forall m env. DbCmd'    env err m => m a
+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
 -- to use the Gargantext Database. It's important, to ease testability,

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:
@@ -118,7 +122,7 @@
   git: "https://gitlab.iscpif.fr/gargantext/crawlers/epo-proxy-api.git"
   subdirs:
   - .
-- commit: b99b9e568c8bdc73af2b8016ed03ba5ee83c2030
+- commit: 3a7d039e07c8564e8ff84ef88480924d18aa5018
   git: "https://gitlab.iscpif.fr/gargantext/crawlers/hal.git"
   subdirs:
   - .
@@ -308,8 +312,7 @@ flags:
   "full-text-search":
     "build-search-demo": false
   gargantext:
-    "disable-db-obfuscation-executable": false
-    "no-phylo-debug-logs": true
+    "no-phylo-debug-logs": false
     "test-crypto": false
   "ghc-lib-parser":
     "threaded-rts": true

test/Test/API/UpdateList.hs

@@ -189,7 +189,7 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
     describe "POST /api/v1.0/lists/:id/csv/add/form/async (CSV)" $ do
 
       it "parses CSV via ngramsListFromCSVData" $ \((_testEnv, _port), _app) -> do
-        simpleNgrams <- liftIO (TIO.readFile =<< getDataFileName "test-data/ngrams/simple.csv")
+        simpleNgrams <- liftIO (TIO.readFile =<< getDataFileName "test-data/ngrams/simple.tsv")
         ngramsListFromTSVData simpleNgrams `shouldBe`
           Right (Map.fromList [ (NgramsTerms, Versioned 0 $ Map.fromList [
                                   (NgramsTerm "abelian group", NgramsRepoElement 1 MapTerm Nothing Nothing (MSet mempty))
@@ -202,12 +202,12 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
           withValidLogin port "alice" (GargPassword "alice") $ \token -> do
             ([listId] :: [NodeId]) <- protectedJSON token "POST" (mkUrl port ("/node/" <> build cId)) [aesonQQ|{"pn_typename":"NodeList","pn_name":"Testing"}|]
             -- Upload the CSV doc
-            simpleNgrams <- liftIO (TIO.readFile =<< getDataFileName "test-data/ngrams/simple.csv")
+            simpleNgrams <- liftIO (TIO.readFile =<< getDataFileName "test-data/ngrams/simple.tsv")
             let tsvFileFormData = [ (T.pack "_wtf_data", simpleNgrams)
-                                  , ("_wtf_filetype", "CSV")
-                                  , ("_wtf_name", "simple.csv")
+                                  , ("_wtf_filetype", "TSV")
+                                  , ("_wtf_name", "simple.tsv")
                                   ]
-            let url         = "/lists/"  <> fromString (show $ _NodeId listId) <> "/csv/add/form/async"
+            let url         = "/lists/"  <> fromString (show $ _NodeId listId) <> "/tsv/add/form/async"
             let mkPollUrl j = "/corpus/" <> fromString (show $ _NodeId listId) <> "/add/form/async/" +|_jph_id j|+ "/poll?limit=1"
             (j :: JobPollHandle) <- postJSONUrlEncoded token (mkUrl port url) (urlEncodeFormStable $ toForm tsvFileFormData)
             j' <- pollUntilFinished token port mkPollUrl j

test/Test/Database/Setup.hs

@@ -15,6 +15,7 @@ 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
@@ -73,12 +74,15 @@ setup = do
       bootstrapDB db pool gargConfig
       ugen <- emptyCounter
       test_nodeStory <- fromDBNodeStoryEnv pool
+      stgs <- devSettings devJwkFile
       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/Database/Types.hs

@@ -28,6 +28,7 @@ import Database.Postgres.Temp qualified as Tmp
 import Gargantext hiding (to)
 import Gargantext.API.Admin.EnvTypes
 import Gargantext.API.Admin.Orchestrator.Types
+import Gargantext.API.Admin.Types
 import Gargantext.API.Errors.Types
 import Gargantext.API.Prelude
 import Gargantext.Core.Mail.Types (HasMail(..))
@@ -61,6 +62,7 @@ data TestEnv = TestEnv {
   , test_nodeStory           :: !NodeStoryEnv
   , test_usernameGen         :: !Counter
   , test_logger              :: !(Logger (GargM TestEnv BackendInternalError))
+  , test_settings            :: !Settings
   }
 
 newtype TestMonad a = TestMonad { runTestMonad :: ReaderT TestEnv IO a }
@@ -104,6 +106,9 @@ instance HasConnectionPool TestEnv where
 instance HasConfig TestEnv where
   hasConfig = to test_config
 
+instance HasSettings TestEnv where
+  settings = to test_settings
+
 instance HasMail TestEnv where
   mailSettings = to $ const (MailConfig { _mc_mail_host       = "localhost"
                                         , _mc_mail_port       = 25

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
@@ -13,7 +13,7 @@ import Data.Text.Lazy as TL
 import Data.TreeDiff
 import Data.Vector qualified as V
 import Gargantext.Core.Text.List.Formats.TSV
-import Gargantext.Core.Types.Phylo
+import Gargantext.Core.Types.Phylo hiding (Phylo(..))
 import Gargantext.Core.Viz.Phylo hiding (EdgeType(..))
 import Gargantext.Core.Viz.Phylo.API.Tools (readPhylo, phylo2dot2json)
 import Gargantext.Core.Viz.Phylo.Example qualified as Cleopatre
@@ -69,6 +69,7 @@ tests = testGroup "Phylo" [
   , testGroup "relatedComponents" [
     testCase "finds simple connection" testRelComp_Connected
   ]
+  , testCase "parses csv phylo" testCsvPhylo
   ]
 
 testCleopatreWithoutLinkExpectedOutput :: Assertion
@@ -248,3 +249,11 @@ testToPhyloDeterminism = do
   let actual = setConfig phyloTestConfig $ toPhylo $ toPhyloWithoutLink corpus config
   expected    <- setConfig phyloTestConfig <$> (readPhylo =<< getDataFileName "test-data/phylo/187481.json")
   assertBool ("Phylo mismatch! " <> show (ansiWlEditExprCompact $ ediff expected actual)) (expected == actual)
+
+testCsvPhylo :: Assertion
+testCsvPhylo = do
+  pth <- getDataFileName "test-data/phylo/cleopatre.golden.csv.json"
+  phyloJson <- eitherDecodeFileStrict' @Phylo pth
+  case phyloJson of
+    Left err -> error err
+    Right _  -> pure ()

test/Test/Offline/Stemming/Lancaster.hs

@@ -8,15 +8,14 @@ import Data.Text qualified as T
 import Gargantext.Core.Text.Terms.Mono.Stem.Internal.Lancaster (stem)
 import Gargantext.Prelude (toS)
 import Test.Tasty
-import Test.Tasty.Golden (goldenVsStringDiff)
+import Test.Tasty.Golden (goldenVsString)
 import qualified Data.ByteString.Lazy as BL
 import qualified Data.Text.Encoding as TE
 
 
 tests :: TestTree
 tests = testGroup "Lancaster" [
-    goldenVsStringDiff "test vector works" (\ref new -> ["cabal", "v2-run", "-v0", "garg-golden-file-diff", "--", ref, new]) "test-data/stemming/lancaster.txt" mkTestVector
-
+    goldenVsString "test vector works" "test-data/stemming/lancaster.txt" mkTestVector
   ]
 
 -- | List un /unstemmed/ test words