Merge branch 'dev' into 86-dev-graphql

bin/gargantext-import/Main.hs

@@ -47,13 +47,13 @@ main = do
     tt = (Multi EN)
     format = CsvGargV3 -- CsvHal --WOS
     corpus :: forall m. FlowCmdM DevEnv GargError m => m CorpusId
-    corpus = flowCorpusFile (UserName $ cs user) (Left (cs name :: Text)) (read limit :: Int) tt  format corpusPath Nothing
+    corpus = flowCorpusFile (UserName $ cs user) (Left (cs name :: Text)) (read limit :: Int) tt  format corpusPath Nothing (\_ -> pure ())
 
     corpusCsvHal :: forall m. FlowCmdM DevEnv GargError m => m CorpusId
-    corpusCsvHal = flowCorpusFile (UserName $ cs user) (Left (cs name :: Text)) (read limit :: Int) tt CsvHal corpusPath Nothing
+    corpusCsvHal = flowCorpusFile (UserName $ cs user) (Left (cs name :: Text)) (read limit :: Int) tt CsvHal corpusPath Nothing (\_ -> pure ())
 
     annuaire :: forall m. FlowCmdM DevEnv GargError m => m CorpusId
-    annuaire = flowAnnuaire (UserName $ cs user) (Left "Annuaire") (Multi EN) corpusPath
+    annuaire = flowAnnuaire (UserName $ cs user) (Left "Annuaire") (Multi EN) corpusPath (\_ -> pure ())
 
   {-
   let debatCorpus :: forall m. FlowCmdM DevEnv GargError m => m CorpusId

devops/postgres/tools/removeUnusedDocuments.sql

+
+WITH repeated AS
+  ( select nn.node2_id AS id, count(*) AS c
+    FROM nodes_nodes nn 
+    GROUP BY nn.node2_id
+  )
+
+DELETE FROM nodes n 
+USING repeated r
+WHERE
+n.id = r.id
+AND r.c <= 1
+; 
+

devops/postgres/tools/removeUnusedNgrams.sql

+
+WITH listed AS
+  ( select nn.ngrams_id AS id, count(*) AS c
+    FROM node_node_ngrams nn 
+    GROUP BY nn.ngrams_id
+  )
+
+--SELECT count(*) from listed l
+-- WHERE
+--l.c <= 1
+
+
+DELETE FROM ngrams n 
+  USING listed l
+  WHERE
+  n.id = l.id
+  AND l.c <= 1
+; 
+
+
+

gargantext.ini_toModify

@@ -67,3 +67,11 @@ DB_PASS = PASSWORD_TO_CHANGE
 LOG_FILE = /var/log/gargantext/backend.log
 LOG_LEVEL = LevelDebug
 LOG_FORMATTER = verbose
+
+[mail]
+MAIL_PORT = 25
+MAIL_HOST = localhost
+MAIL_USER = gargantext
+MAIL_PASSWORD =
+# Normal | SSL | TLS | STARTTLS
+MAIL_LOGIN_TYPE = Normal

package.yaml

 name: gargantext
-version: '0.0.4.6'
+version: '0.0.4.7.1'
 synopsis: Search, map, share
 description: Please see README.md
 category: Data
@@ -371,19 +371,19 @@ executables:
       - gargantext-prelude
       - base
 
-  gargantext-upgrade:
-    main: Main.hs
-    source-dirs: bin/gargantext-upgrade
-    ghc-options:
-    - -threaded
-    - -rtsopts
-    - -with-rtsopts=-N
-    - -O2
-    - -Wmissing-signatures
-    dependencies:
-      - gargantext
-      - gargantext-prelude
-      - base
+#  gargantext-upgrade:
+#    main: Main.hs
+#    source-dirs: bin/gargantext-upgrade
+#    ghc-options:
+#    - -threaded
+#    - -rtsopts
+#    - -with-rtsopts=-N
+#    - -O2
+#    - -Wmissing-signatures
+#    dependencies:
+#      - gargantext
+#      - gargantext-prelude
+#      - base
 
   gargantext-admin:
     main: Main.hs
@@ -399,22 +399,23 @@ executables:
       - gargantext-prelude
       - base
 
-  gargantext-cbor2json:
-    main: Main.hs
-    source-dirs: bin/gargantext-cbor2json
-    ghc-options:
-    - -threaded
-    - -rtsopts
-    - -with-rtsopts=-N
-    - -O2
-    - -Wmissing-signatures
-    dependencies:
-      - gargantext
-      - gargantext-prelude
-      - base
-      - bytestring
-      - aeson
-      - serialise
+
+#  gargantext-cbor2json:
+#    main: Main.hs
+#    source-dirs: bin/gargantext-cbor2json
+#    ghc-options:
+#    - -threaded
+#    - -rtsopts
+#    - -with-rtsopts=-N
+#    - -O2
+#    - -Wmissing-signatures
+#    dependencies:
+#      - gargantext
+#      - gargantext-prelude
+#      - base
+#      - bytestring
+#      - aeson
+#      - serialise
 
 
 tests:

src/Gargantext/API/Admin/Auth.hs

@@ -20,6 +20,7 @@ TODO-ACCESS Critical
 
 -}
 
+{-# LANGUAGE MonoLocalBinds      #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
 module Gargantext.API.Admin.Auth
@@ -35,17 +36,18 @@ import Servant
 import Servant.Auth.Server
 import qualified Gargantext.Prelude.Crypto.Auth as Auth
 
-import Gargantext.API.Admin.Types
 import Gargantext.API.Admin.Auth.Types
+import Gargantext.API.Admin.Types
 import Gargantext.API.Prelude (HasJoseError(..), joseError, HasServerError, GargServerC)
+import Gargantext.Core.Mail.Types (HasMail)
 import Gargantext.Core.Types.Individu (User(..), Username, GargPassword(..))
+import Gargantext.Database.Admin.Types.Node (NodeId(..), UserId)
+import Gargantext.Database.Prelude (Cmd', CmdM, HasConnectionPool, HasConfig)
+import Gargantext.Database.Query.Table.User
 import Gargantext.Database.Query.Tree (isDescendantOf, isIn)
 import Gargantext.Database.Query.Tree.Root (getRoot)
 import Gargantext.Database.Schema.Node (NodePoly(_node_id))
-import Gargantext.Database.Admin.Types.Node (NodeId(..), UserId)
-import Gargantext.Database.Prelude (Cmd', CmdM, HasConnectionPool, HasConfig)
 import Gargantext.Prelude hiding (reverse)
-import Gargantext.Database.Query.Table.User
 
 ---------------------------------------------------
 
@@ -60,7 +62,7 @@ makeTokenForUser uid = do
   either joseError (pure . toStrict . decodeUtf8) e
   -- TODO not sure about the encoding...
 
-checkAuthRequest :: (HasSettings env, HasConnectionPool env, HasJoseError err, HasConfig env)
+checkAuthRequest :: (HasSettings env, HasConnectionPool env, HasJoseError err, HasConfig env, HasMail env)
                  => Username
                  -> GargPassword
                  -> Cmd' env err CheckAuth
@@ -79,7 +81,7 @@ checkAuthRequest u (GargPassword p) = do
               token <- makeTokenForUser uid
               pure $ Valid token uid
 
-auth :: (HasSettings env, HasConnectionPool env, HasJoseError err, HasConfig env)
+auth :: (HasSettings env, HasConnectionPool env, HasJoseError err, HasConfig env, HasMail env)
      => AuthRequest -> Cmd' env err AuthResponse
 auth (AuthRequest u p) = do
   checkAuthRequest' <- checkAuthRequest u p

src/Gargantext/API/Admin/EnvTypes.hs

@@ -14,24 +14,25 @@ import Servant.Job.Async (HasJobEnv(..), Job)
 import System.Log.FastLogger
 import qualified Servant.Job.Core
 
-import Gargantext.API.Ngrams.Types (HasRepoVar(..), HasRepoSaver(..), HasRepo(..), RepoEnv(..))
 import Gargantext.API.Admin.Types
 import Gargantext.API.Admin.Orchestrator.Types
+import Gargantext.Core.NodeStory
+import Gargantext.Core.Mail.Types (HasMail, mailSettings)
 import Gargantext.Database.Prelude (HasConnectionPool(..), HasConfig(..))
 import Gargantext.Prelude
 import Gargantext.Prelude.Config (GargConfig(..))
-import Gargantext.Core.NodeStory
+import Gargantext.Prelude.Mail.Types (MailConfig)
 
 data Env = Env
   { _env_settings  :: !Settings
   , _env_logger    :: !LoggerSet
   , _env_pool      :: !(Pool Connection)
-  , _env_repo      :: !RepoEnv
   , _env_nodeStory :: !NodeStoryEnv
   , _env_manager   :: !Manager
   , _env_self_url  :: !BaseUrl
   , _env_scrapers  :: !ScrapersEnv
   , _env_config    :: !GargConfig
+  , _env_mail      :: !MailConfig
   }
   deriving (Generic)
 
@@ -55,15 +56,8 @@ instance HasNodeStorySaver Env where
 instance HasSettings Env where
   settings = env_settings
 
--- Specific to Repo
-instance HasRepoVar Env where
-  repoVar = repoEnv . repoVar
-instance HasRepoSaver Env where
-  repoSaver = repoEnv . repoSaver
-instance HasRepo Env where
-  repoEnv = env_repo
-
-
+instance HasMail Env where
+  mailSettings = env_mail
 
 
 instance Servant.Job.Core.HasEnv Env (Job JobLog JobLog) where
@@ -83,10 +77,10 @@ makeLenses ''MockEnv
 
 data DevEnv = DevEnv
   { _dev_env_settings  :: !Settings
-  , _dev_env_repo      :: !RepoEnv
   , _dev_env_config    :: !GargConfig
   , _dev_env_pool      :: !(Pool Connection)
   , _dev_env_nodeStory :: !NodeStoryEnv
+  , _dev_env_mail      :: !MailConfig
   }
 
 makeLenses ''DevEnv
@@ -110,12 +104,5 @@ instance HasNodeStoryVar DevEnv where
 instance HasNodeStorySaver DevEnv where
   hasNodeStorySaver = hasNodeStory . nse_saver
 
-
-instance HasRepoVar DevEnv where
-  repoVar = repoEnv . repoVar
-instance HasRepoSaver DevEnv where
-  repoSaver = repoEnv . repoSaver
-instance HasRepo DevEnv where
-  repoEnv = dev_env_repo
-
-
+instance HasMail DevEnv where
+  mailSettings = dev_env_mail

src/Gargantext/API/Admin/Settings.hs

@@ -18,9 +18,8 @@ TODO-SECURITY: Critical
 module Gargantext.API.Admin.Settings
     where
 
-import Codec.Serialise (Serialise(), serialise, deserialise)
-import Control.Concurrent
-import Control.Debounce (mkDebounce, defaultDebounceSettings, debounceFreq, debounceAction)
+-- import Control.Debounce (mkDebounce, defaultDebounceSettings, debounceFreq, debounceAction)
+import Codec.Serialise (Serialise(), serialise)
 import Control.Lens
 import Control.Monad.Logger
 import Control.Monad.Reader
@@ -34,7 +33,7 @@ import Servant.Auth.Server (defaultJWTSettings, CookieSettings(..), XsrfCookieSe
 import Servant.Client (parseBaseUrl)
 import Servant.Job.Async (newJobEnv, defaultSettings)
 import System.Directory
-import System.FileLock (tryLockFile, unlockFile, SharedExclusive(Exclusive))
+-- import System.FileLock (tryLockFile, unlockFile, SharedExclusive(Exclusive))
 import System.IO (FilePath, hClose)
 import System.IO.Temp (withTempFile)
 import System.Log.FastLogger
@@ -43,10 +42,11 @@ import qualified Data.ByteString.Lazy as L
 
 import Gargantext.API.Admin.EnvTypes
 import Gargantext.API.Admin.Types
-import Gargantext.API.Ngrams.Types (NgramsRepo, HasRepo(..), RepoEnv(..), r_version, initRepo, renv_var, renv_lock)
-import Gargantext.Database.Prelude (databaseParameters, HasConfig(..))
+-- import Gargantext.API.Ngrams.Types (NgramsRepo, HasRepo(..), RepoEnv(..), r_version, initRepo, renv_var, renv_lock)
+import Gargantext.Database.Prelude (databaseParameters)
 import Gargantext.Prelude
-import Gargantext.Prelude.Config (gc_repofilepath)
+-- import Gargantext.Prelude.Config (gc_repofilepath)
+import qualified Gargantext.Prelude.Mail as Mail
 
 devSettings :: FilePath -> IO Settings
 devSettings jwkFile = do
@@ -113,7 +113,7 @@ repoSaverAction repoDir a = do
 
 
 
---{-
+{-
 -- The use of mkDebounce makes sure that repoSaverAction is not called too often.
 -- If repoSaverAction start taking more time than the debounceFreq then it should
 -- be increased.
@@ -133,6 +133,8 @@ mkRepoSaver repoDir repo_var = mkDebounce settings'
                    -- Add a new MVar just for saving.
                  }
 
+-}
+{-
 readRepoEnv :: FilePath -> IO RepoEnv
 readRepoEnv repoDir = do
   -- Does file exist ? :: Bool
@@ -178,27 +180,27 @@ newEnv port file = do
   self_url_env  <- parseBaseUrl $ "http://0.0.0.0:" <> show port
   dbParam       <- databaseParameters file
   pool          <- newPool dbParam
-  repo          <- readRepoEnv (_gc_repofilepath config_env)
   nodeStory_env <- readNodeStoryEnv (_gc_repofilepath config_env)
   scrapers_env  <- newJobEnv defaultSettings manager_env
   logger        <- newStderrLoggerSet defaultBufSize
+  config_mail   <- Mail.readConfig file
 
   pure $ Env
     { _env_settings  = settings'
     , _env_logger    = logger
     , _env_pool      = pool
-    , _env_repo      = repo
     , _env_nodeStory = nodeStory_env
     , _env_manager   = manager_env
     , _env_scrapers  = scrapers_env
     , _env_self_url  = self_url_env
     , _env_config    = config_env
+    , _env_mail      = config_mail
     }
 
 newPool :: ConnectInfo -> IO (Pool Connection)
 newPool param = createPool (connect param) close 1 (60*60) 8
 
---{-
+{-
 cleanEnv :: (HasConfig env, HasRepo env) => env -> IO ()
 cleanEnv env = do
   r <- takeMVar (env ^. repoEnv . renv_var)

src/Gargantext/API/Dev.hs

@@ -23,6 +23,7 @@ import Gargantext.Core.NodeStory
 import Gargantext.Database.Prelude
 import Gargantext.Prelude
 import Gargantext.Prelude.Config (GargConfig(..), readConfig)
+import qualified Gargantext.Prelude.Mail as Mail
 import Servant
 import System.IO (FilePath)
 
@@ -31,7 +32,7 @@ type IniPath  = FilePath
 withDevEnv :: IniPath -> (DevEnv -> IO a) -> IO a
 withDevEnv iniPath k = do
   env <- newDevEnv
-  k env `finally` cleanEnv env
+  k env -- `finally` cleanEnv env
 
   where
     newDevEnv = do
@@ -39,14 +40,14 @@ withDevEnv iniPath k = do
       dbParam <- databaseParameters iniPath
       nodeStory_env <- readNodeStoryEnv (_gc_repofilepath cfg)
       pool    <- newPool            dbParam
-      repo    <- readRepoEnv        (_gc_repofilepath cfg)
       setts   <- devSettings devJwkFile
+      mail    <- Mail.readConfig iniPath
       pure $ DevEnv
         { _dev_env_pool     = pool
-        , _dev_env_repo     = repo
         , _dev_env_nodeStory  = nodeStory_env
         , _dev_env_settings = setts
         , _dev_env_config   = cfg
+        , _dev_env_mail      = mail
         }
 
 -- | Run Cmd Sugar for the Repl (GHCI)

src/Gargantext/API/Ngrams.hs

@@ -33,7 +33,6 @@ module Gargantext.API.Ngrams
   , apiNgramsTableCorpus
   , apiNgramsTableDoc
 
-  , NgramsStatePatch
   , NgramsTablePatch
   , NgramsTableMap
 
@@ -52,15 +51,10 @@ module Gargantext.API.Ngrams
   , r_version
   , r_state
   , r_history
-  , NgramsRepo
   , NgramsRepoElement(..)
   , saveNodeStory
   , initRepo
 
-  , RepoEnv(..)
-  , renv_var
-  , renv_lock
-
   , TabType(..)
 
   , QueryParamR
@@ -102,6 +96,7 @@ import Gargantext.API.Job
 import Gargantext.API.Ngrams.Types
 import Gargantext.API.Prelude
 import Gargantext.Core.NodeStory
+import Gargantext.Core.Mail.Types (HasMail)
 import Gargantext.Core.Types (ListType(..), NodeId, ListId, DocId, Limit, Offset, TODO, assertValid, HasInvalidError)
 import Gargantext.API.Ngrams.Tools
 import Gargantext.Database.Action.Flow.Types
@@ -280,7 +275,7 @@ newNgramsFromNgramsStatePatch p =
 
 
 
-commitStatePatch :: HasNodeStory env err m
+commitStatePatch :: (HasNodeStory env err m, HasMail env)
                  => ListId
                  ->    Versioned NgramsStatePatch'
                  -> m (Versioned NgramsStatePatch')
@@ -348,6 +343,7 @@ tableNgramsPull listId ngramsType p_version = do
 tableNgramsPut :: ( HasNodeStory env err m
                   , HasInvalidError err
                   , HasSettings env
+                  , HasMail env
                   )
                  => TabType
                  -> ListId
@@ -494,7 +490,7 @@ type MaxSize = Int
 
 
 getTableNgrams :: forall env err m.
-                  (HasNodeStory env err m, HasNodeError err, HasConnectionPool env, HasConfig env)
+                  (HasNodeStory env err m, HasNodeError err, HasConnectionPool env, HasConfig env, HasMail env)
                => NodeType -> NodeId -> TabType
                -> ListId -> Limit -> Maybe Offset
                -> Maybe ListType
@@ -617,7 +613,7 @@ getTableNgrams _nType nId tabType listId limit_ offset
 
 
 scoresRecomputeTableNgrams :: forall env err m.
-  (HasNodeStory env err m, HasNodeError err, HasConnectionPool env, HasConfig env)
+  (HasNodeStory env err m, HasNodeError err, HasConnectionPool env, HasConfig env, HasMail env)
   => NodeId -> TabType -> ListId -> m Int
 scoresRecomputeTableNgrams nId tabType listId = do
   tableMap <- getNgramsTableMap listId ngramsType
@@ -712,7 +708,7 @@ type TableNgramsAsyncApi = Summary "Table Ngrams Async API"
                            :> "update"
                            :> AsyncJobs JobLog '[JSON] UpdateTableNgramsCharts JobLog
 
-getTableNgramsCorpus :: (HasNodeStory env err m, HasNodeError err, HasConnectionPool env, HasConfig env)
+getTableNgramsCorpus :: (HasNodeStory env err m, HasNodeError err, HasConnectionPool env, HasConfig env, HasMail env)
                => NodeId
                -> TabType
                -> ListId
@@ -746,7 +742,7 @@ getTableNgramsVersion _nId _tabType listId = currentVersion listId
 
 
 -- | Text search is deactivated for now for ngrams by doc only
-getTableNgramsDoc :: (HasNodeStory env err m, HasNodeError err, HasConnectionPool env, HasConfig env)
+getTableNgramsDoc :: (HasNodeStory env err m, HasNodeError err, HasConnectionPool env, HasConfig env, HasMail env)
                => DocId -> TabType
                -> ListId -> Limit -> Maybe Offset
                -> Maybe ListType

src/Gargantext/API/Ngrams/Tools.hs

@@ -35,12 +35,12 @@ mergeNgramsElement _neOld neNew = neNew
 
 type RootTerm = NgramsTerm
 
-
+{-
 getRepo :: RepoCmdM env err m => m NgramsRepo
 getRepo = do
   v <- view repoVar
   liftBase $ readMVar v
-
+-}
 
 getRepo' :: HasNodeStory env err m
          => [ListId] -> m NodeListStory

src/Gargantext/API/Ngrams/Types.hs

@@ -11,8 +11,7 @@ module Gargantext.API.Ngrams.Types where
 
 import Codec.Serialise (Serialise())
 import Control.Category ((>>>))
-import Control.Concurrent
-import Control.Lens (makeLenses, makePrisms, Iso', iso, from, (.~), (?=), (#), to, folded, {-withIndex, ifolded,-} view, use, (^.), (^?), (%~), (.~), (%=), at, _Just, Each(..), itraverse_, both, forOf_, (?~), Getter)
+import Control.Lens (makeLenses, makePrisms, Iso', iso, from, (.~), (?=), (#), to, folded, {-withIndex, ifolded,-} view, use, (^.), (^?), (%~), (.~), (%=), at, _Just, Each(..), itraverse_, both, forOf_, (?~))
 import Control.Monad.State
 import Data.Aeson hiding ((.=))
 import Data.Aeson.TH (deriveJSON)
@@ -39,7 +38,7 @@ import Gargantext.Prelude.Crypto.Hash (IsHashable(..))
 import Protolude (maybeToEither)
 import Servant hiding (Patch)
 import Servant.Job.Utils (jsonOptions)
-import System.FileLock (FileLock)
+-- import System.FileLock (FileLock)
 import Test.QuickCheck (elements, frequency)
 import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
 import qualified Data.HashMap.Strict.InsOrd             as InsOrdHashMap
@@ -676,11 +675,6 @@ data Repo s p = Repo
   }
   deriving (Generic, Show)
 
--- | TO REMOVE
-type NgramsRepo       = Repo     NgramsState NgramsStatePatch
-type NgramsState      = Map      TableNgrams.NgramsType (Map NodeId NgramsTableMap)
-type NgramsStatePatch = PatchMap TableNgrams.NgramsType (PatchMap NodeId NgramsTablePatch)
-
 ----------------------------------------------------------------------
 
 instance (FromJSON s, FromJSON p) => FromJSON (Repo s p) where
@@ -697,52 +691,16 @@ makeLenses ''Repo
 initRepo :: Monoid s => Repo s p
 initRepo = Repo 1 mempty []
 
-instance Serialise (PM.PatchMap NodeId NgramsTablePatch)
-instance Serialise NgramsStatePatch
 
-initMockRepo :: NgramsRepo
-initMockRepo = Repo 1 s []
-  where
-    s = Map.singleton TableNgrams.NgramsTerms
-      $ Map.singleton 47254
-      $ Map.fromList
-      [ (n ^. ne_ngrams, ngramsElementToRepo n) | n <- mockTable ^. _NgramsTable ]
 
 --------------------
 
-data RepoEnv = RepoEnv
-  { _renv_var   :: !(MVar NgramsRepo)
-  , _renv_saver :: !(IO ())
-  , _renv_lock  :: !FileLock
-  }
-  deriving (Generic)
-
-makeLenses ''RepoEnv
-
 type RepoCmdM   env err m =
   ( CmdM'             env err m
-  , HasRepo           env
   , HasConnectionPool env
   , HasConfig         env
   )
 
-class (HasRepoVar env, HasRepoSaver env)
-  => HasRepo env where
-  repoEnv :: Getter env RepoEnv
-class HasRepoVar env where
-  repoVar :: Getter env (MVar NgramsRepo)
-class HasRepoSaver env where
-  repoSaver :: Getter env (IO ())
-
-
-instance HasRepo RepoEnv where
-  repoEnv = identity
-instance HasRepoVar (MVar NgramsRepo) where
-  repoVar = identity
-instance HasRepoVar RepoEnv where
-  repoVar = renv_var
-instance HasRepoSaver RepoEnv where
-  repoSaver = renv_saver
 
 ------------------------------------------------------------------------
 

src/Gargantext/API/Node/Contact.hs

@@ -93,7 +93,7 @@ addContact u nId (AddContactParams fn ln) logStatus = do
                    , _scst_remaining = Just 1
                    , _scst_events    = Just []
                    }
-  _ <- flow (Nothing :: Maybe HyperdataAnnuaire) u (Right [nId]) (Multi EN) Nothing [[hyperdataContact fn ln]]
+  _ <- flow (Nothing :: Maybe HyperdataAnnuaire) u (Right [nId]) (Multi EN) Nothing [[hyperdataContact fn ln]] logStatus
 
   pure  JobLog { _scst_succeeded = Just 2
                , _scst_failed    = Just 0

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

@@ -217,11 +217,11 @@ addToCorpusWithQuery user cid (WithQuery { _wq_query = q
   
       logStatus JobLog { _scst_succeeded = Just 2
                        , _scst_failed    = Just 0
-                       , _scst_remaining = Just 1
+                       , _scst_remaining = Just $ 1 + length txts
                        , _scst_events    = Just []
                        }
 
-      cids <- mapM (\txt -> flowDataText user txt (Multi l) cid Nothing) txts
+      cids <- mapM (\txt -> flowDataText user txt (Multi l) cid Nothing logStatus) txts
       printDebug "corpus id" cids
       printDebug "sending email" ("xxxxxxxxxxxxxxxxxxxxx" :: Text)
       sendMail user
@@ -297,6 +297,7 @@ addToCorpusWithForm user cid (NewWithForm ft d l _n) logStatus jobLog = do
                           (Multi $ fromMaybe EN l)
                           Nothing
                           (map (map toHyperdataDocument) docs)
+                          logStatus
 
       printDebug "Extraction finished   : " cid
       printDebug "sending email" ("xxxxxxxxxxxxxxxxxxxxx" :: Text)

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

@@ -63,6 +63,7 @@ instance FromHttpApiData FileType
     parseUrlPiece "CSV_HAL"   = pure CSV_HAL
     parseUrlPiece "PresseRis" = pure PresseRIS
     parseUrlPiece "ZIP"       = pure ZIP
+    parseUrlPiece "WOS"       = pure WOS
     parseUrlPiece _           = pure CSV -- TODO error here
 
 

src/Gargantext/API/Node/DocumentUpload.hs

@@ -107,6 +107,6 @@ documentUpload uId nId doc logStatus = do
                              , _hd_publication_minute = Nothing
                              , _hd_publication_second = Nothing
                              , _hd_language_iso2 = Just $ T.pack $ show EN }
-  _ <- flowDataText (RootId (NodeId uId)) (DataNew [[hd]]) (Multi EN) cId Nothing
+  _ <- flowDataText (RootId (NodeId uId)) (DataNew [[hd]]) (Multi EN) cId Nothing logStatus
 
   pure $ jobLogSuccess jl

src/Gargantext/API/Node/DocumentsFromWriteNodes.hs

@@ -100,7 +100,7 @@ documentsFromWriteNodes uId nId _p logStatus = do
   let parsedE = (\(node, contents) -> hyperdataDocumentFromFrameWrite (node ^. node_hyperdata, contents)) <$> frameWritesWithContents
   let parsed = rights parsedE
 
-  _ <- flowDataText (RootId (NodeId uId)) (DataNew [parsed]) (Multi EN) cId Nothing
+  _ <- flowDataText (RootId (NodeId uId)) (DataNew [parsed]) (Multi EN) cId Nothing logStatus
 
   pure $ jobLogSuccess jobLog
 ------------------------------------------------------------------------

src/Gargantext/API/Prelude.hs

@@ -34,6 +34,7 @@ import Data.Validity
 import Gargantext.API.Admin.Orchestrator.Types
 import Gargantext.API.Admin.Types
 import Gargantext.Core.NodeStory
+import Gargantext.Core.Mail.Types (HasMail)
 import Gargantext.Core.Types
 import Gargantext.Database.Prelude
 import Gargantext.Database.Query.Table.Node.Error (NodeError(..), HasNodeError(..))
@@ -55,6 +56,7 @@ type EnvC env =
   , HasJobEnv         env JobLog JobLog
   , HasConfig         env
   , HasNodeStoryEnv   env
+  , HasMail           env
   )
 
 type ErrC err =

src/Gargantext/Core/Mail.hs

@@ -7,19 +7,19 @@ Maintainer  : team@gargantext.org
 Stability   : experimental
 Portability : POSIX
 
-TODO put main configuration variables in gargantext.ini
-
 -}
 
-module Gargantext.Core.Mail
-  where
+module Gargantext.Core.Mail where
 
+import Control.Lens ((^.))
 import Data.Text (Text, unlines, splitOn)
 import Gargantext.Core.Types.Individu
 import Gargantext.Prelude
 import Gargantext.Prelude.Mail (gargMail, GargMail(..))
+import Gargantext.Prelude.Mail.Types (MailConfig, mc_mail_host)
 import qualified Data.List as List
 
+
 -- | Tool to put elsewhere
 isEmail :: Text -> Bool
 isEmail = ((==) 2) . List.length . (splitOn "@")
@@ -38,12 +38,12 @@ data MailModel = Invitation { invitation_user :: NewUser GargPassword }
                             }
 ------------------------------------------------------------------------
 ------------------------------------------------------------------------
-mail :: ServerAddress -> MailModel -> IO ()
-mail server model = gargMail (GargMail m (Just u) subject body)
+mail :: MailConfig -> MailModel -> IO ()
+mail cfg model = gargMail cfg (GargMail m (Just u) subject body)
   where
     (m,u)   = email_to         model
     subject = email_subject    model
-    body    = emailWith server model
+    body    = emailWith (cfg ^. mc_mail_host) model
 
 ------------------------------------------------------------------------
 emailWith :: ServerAddress -> MailModel -> Text

src/Gargantext/Core/Mail/Types.hs

+{-|
+Module      : Gargantext.Core.Mail.Types
+Description :
+Copyright   : (c) CNRS, 2017-Present
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+
+-}
+
+module Gargantext.Core.Mail.Types where
+
+import Control.Lens (Getter)
+import Gargantext.Prelude.Mail.Types (MailConfig)
+
+class HasMail env where
+  mailSettings :: Getter env MailConfig

src/Gargantext/Core/NodeStory.hs

@@ -32,7 +32,6 @@ import Control.Monad.Except
 import Control.Monad.Reader
 import Data.Aeson hiding ((.=), decode)
 import Data.Map.Strict (Map)
-import Data.Maybe (fromMaybe)
 import Data.Monoid
 import Data.Semigroup
 import GHC.Generics (Generic)
@@ -48,7 +47,6 @@ import System.IO.Temp (withTempFile)
 import qualified Data.ByteString.Lazy                   as DBL
 import qualified Data.List                              as List
 import qualified Data.Map.Strict                        as Map
-import qualified Data.Map.Strict.Patch.Internal         as Patch
 import qualified Gargantext.Database.Query.Table.Ngrams as TableNgrams
 
 ------------------------------------------------------------------------
@@ -207,6 +205,7 @@ nodeStoryPath repoDir nId = repoDir <> "/" <> filename
 
 ------------------------------------------------------------------------
 -- TODO : repo Migration TODO TESTS
+{-
 repoMigration :: NodeStoryDir -> NgramsRepo -> IO ()
 repoMigration fp r = writeNodeStories fp (repoToNodeListStory r)
 
@@ -249,7 +248,7 @@ ngramsStatePatch_migration np' = Map.fromListWith (<>)
                        -> (nid, [fst $ Patch.singleton nt table])
                      ) $ Patch.toList nTable
             ) $ Patch.toList p
-
+-}
 ------------------------------------------------------------------------
 
 {- | Node Story for each NodeType where the Key of the Map is NodeId

src/Gargantext/Database/Action/Delete.hs

@@ -21,25 +21,26 @@ import Control.Lens     (view, (^.))
 import Data.Text
 import Servant
 
+import Gargantext.Core
+import Gargantext.Core.Mail.Types (HasMail)
 import Gargantext.Core.Types.Individu (User(..))
-import Gargantext.Database.Action.User (getUserId)
 import Gargantext.Database.Action.Share (delFolderTeam)
-import Gargantext.Core
+import Gargantext.Database.Action.User (getUserId)
 import Gargantext.Database.Admin.Types.Hyperdata.File
 import Gargantext.Database.Admin.Types.Node -- (NodeType(..))
 import Gargantext.Database.Prelude (Cmd', HasConfig, HasConnectionPool)
-import qualified Gargantext.Database.Query.Table.Node as N (getNode, deleteNode)
 import Gargantext.Database.Query.Table.Node (getNodeWith)
 import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
 import Gargantext.Database.Schema.Node
 import Gargantext.Prelude
 import qualified Gargantext.Database.GargDB as GargDB
+import qualified Gargantext.Database.Query.Table.Node as N (getNode, deleteNode)
 
 ------------------------------------------------------------------------
 -- TODO
 -- Delete Corpus children accoring its types
 -- Delete NodeList (NodeStory + cbor file)
-deleteNode :: (HasConfig env, HasConnectionPool env, HasNodeError err)
+deleteNode :: (HasMail env, HasConfig env, HasConnectionPool env, HasNodeError err)
            => User
            -> NodeId
            -> Cmd' env err Int

src/Gargantext/Database/Action/Flow.hs

@@ -65,6 +65,7 @@ import qualified Data.HashMap.Strict as HashMap
 import qualified Gargantext.Data.HashMap.Strict.Utils as HashMap
 import qualified Data.Map as Map
 
+import Gargantext.API.Admin.Orchestrator.Types (JobLog(..))
 import Gargantext.Core (Lang(..), PosTagAlgo(..))
 import Gargantext.Core.Ext.IMT (toSchoolName)
 import Gargantext.Core.Ext.IMTUser (readFile_Annuaire)
@@ -154,11 +155,12 @@ flowDataText :: ( FlowCmdM env err m
                 -> TermType Lang
                 -> CorpusId
                 -> Maybe FlowSocialListWith
+                -> (JobLog -> m ())
                 -> m CorpusId
-flowDataText u (DataOld ids) tt cid mfslw = flowCorpusUser (_tt_lang tt) u (Right [cid]) corpusType ids mfslw
+flowDataText u (DataOld ids) tt cid mfslw _ = flowCorpusUser (_tt_lang tt) u (Right [cid]) corpusType ids mfslw
   where
     corpusType = (Nothing :: Maybe HyperdataCorpus)
-flowDataText u (DataNew txt) tt cid mfslw = flowCorpus u (Right [cid]) tt mfslw txt
+flowDataText u (DataNew txt) tt cid mfslw logStatus = flowCorpus u (Right [cid]) tt mfslw txt logStatus
 
 ------------------------------------------------------------------------
 -- TODO use proxy
@@ -167,10 +169,11 @@ flowAnnuaire :: (FlowCmdM env err m)
              -> Either CorpusName [CorpusId]
              -> (TermType Lang)
              -> FilePath
+             -> (JobLog -> m ())
              -> m AnnuaireId
-flowAnnuaire u n l filePath = do
+flowAnnuaire u n l filePath logStatus = do
   docs <- liftBase $ (( splitEvery 500 <$> readFile_Annuaire filePath) :: IO [[HyperdataContact]])
-  flow (Nothing :: Maybe HyperdataAnnuaire) u n l Nothing docs
+  flow (Nothing :: Maybe HyperdataAnnuaire) u n l Nothing docs logStatus
 
 ------------------------------------------------------------------------
 flowCorpusFile :: (FlowCmdM env err m)
@@ -179,13 +182,14 @@ flowCorpusFile :: (FlowCmdM env err m)
            -> Limit -- Limit the number of docs (for dev purpose)
            -> TermType Lang -> FileFormat -> FilePath
            -> Maybe FlowSocialListWith
+           -> (JobLog -> m ())
            -> m CorpusId
-flowCorpusFile u n l la ff fp mfslw = do
+flowCorpusFile u n l la ff fp mfslw logStatus = do
   eParsed <- liftBase $ parseFile ff fp
   case eParsed of
     Right parsed -> do
       let docs = splitEvery 500 $ take l parsed
-      flowCorpus u n la mfslw (map (map toHyperdataDocument) docs)
+      flowCorpus u n la mfslw (map (map toHyperdataDocument) docs) logStatus
     Left e       -> panic $ "Error: " <> (T.pack e)
 
 ------------------------------------------------------------------------
@@ -197,6 +201,7 @@ flowCorpus :: (FlowCmdM env err m, FlowCorpus a)
            -> TermType Lang
            -> Maybe FlowSocialListWith
            -> [[a]]
+           -> (JobLog -> m ())
            -> m CorpusId
 flowCorpus = flow (Nothing :: Maybe HyperdataCorpus)
 
@@ -211,10 +216,19 @@ flow :: ( FlowCmdM env err m
         -> TermType Lang
         -> Maybe FlowSocialListWith
         -> [[a]]
+        -> (JobLog -> m ())
         -> m CorpusId
-flow c u cn la mfslw docs = do
+flow c u cn la mfslw docs logStatus = do
   -- TODO if public insertMasterDocs else insertUserDocs
-  ids <- traverse (insertMasterDocs c la) docs
+  ids <- traverse (\(idx, doc) -> do
+                      id <- insertMasterDocs c la doc
+                      logStatus JobLog { _scst_succeeded = Just $ 1 + idx
+                                       , _scst_failed    = Just 0
+                                       , _scst_remaining = Just $ length docs - idx
+                                       , _scst_events    = Just []
+                                       }
+                      pure id
+                  ) (zip [1..] docs)
   flowCorpusUser (la ^. tt_lang) u cn c (concat ids) mfslw
 
 ------------------------------------------------------------------------

src/Gargantext/Database/Action/Mail.hs

@@ -14,21 +14,21 @@ module Gargantext.Database.Action.Mail
   where
 
 import Control.Lens (view)
-import Gargantext.Prelude
+import Gargantext.Core.Mail (mail, MailModel(..))
+import Gargantext.Core.Mail.Types (mailSettings)
+import Gargantext.Core.Types.Individu (User(..))
+import Gargantext.Database.Action.User
 import Gargantext.Database.Prelude
 import Gargantext.Database.Query.Table.Node.Error (HasNodeError(..))
-import Gargantext.Core.Mail
-import Gargantext.Prelude.Config
 import Gargantext.Database.Schema.User
-import Gargantext.Database.Action.User
-import Gargantext.Core.Types.Individu (User(..))
+import Gargantext.Prelude
 
 ------------------------------------------------------------------------
 
 sendMail :: HasNodeError err => User -> Cmd err ()
 sendMail u = do
-  server <- view $ hasConfig . gc_url
+  cfg <- view $ mailSettings
   userLight <- getUserLightDB u
-  liftBase $ mail server (MailInfo { mailInfo_username = userLight_username userLight
+  liftBase $ mail cfg (MailInfo { mailInfo_username = userLight_username userLight
                                 , mailInfo_address = userLight_email userLight })
 

src/Gargantext/Database/Action/Metrics.hs

@@ -18,6 +18,7 @@ import Data.Vector (Vector)
 import Gargantext.API.Ngrams.Tools (filterListWithRoot, groupNodesByNgrams, Diagonal(..), getCoocByNgrams, mapTermListRoot, RootTerm, getRepo')
 import Gargantext.API.Ngrams.Types (TabType(..), ngramsTypeFromTabType, NgramsTerm)
 import Gargantext.Core.Text.Metrics (scored, Scored(..), {-localMetrics, toScored-})
+import Gargantext.Core.Mail.Types (HasMail)
 import Gargantext.Core.Types (ListType(..), Limit, NodeType(..))
 import Gargantext.Core.NodeStory
 import Gargantext.Database.Action.Flow.Types (FlowCmdM)
@@ -62,7 +63,7 @@ getNgramsCooc cId maybeListId tabType maybeLimit = do
 
 
 
-getNgrams :: (HasNodeStory env err m)
+getNgrams :: (HasMail env, HasNodeStory env err m)
             => CorpusId -> Maybe ListId -> TabType
             -> m ( HashMap NgramsTerm (ListType, Maybe NgramsTerm)
                  , HashMap NgramsTerm (Maybe RootTerm)

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

@@ -16,24 +16,25 @@ module Gargantext.Database.Action.User.New
 import Control.Lens (view)
 import Control.Monad.Random
 import Data.Text (Text, splitOn)
+import qualified Data.Text as Text
 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.Prelude
 import Gargantext.Database.Query.Table.Node.Error (HasNodeError(..), nodeError, NodeError(..))
 import Gargantext.Database.Query.Table.User
 import Gargantext.Prelude
-import Gargantext.Prelude.Config
 import Gargantext.Prelude.Crypto.Pass.User (gargPass)
-import qualified Data.Text as Text
+import Gargantext.Prelude.Mail.Types (MailConfig)
 ------------------------------------------------------------------------
 ------------------------------------------------------------------------
-newUsers :: (CmdM env err m, MonadRandom m, HasNodeError err)
+newUsers :: (CmdM env err m, MonadRandom m, HasNodeError err, HasMail env)
          => [EmailAddress] -> m Int64
 newUsers us = do
   us' <- mapM newUserQuick us
-  url <- view $ hasConfig . gc_url
-  newUsers' url us'
+  config <- view $ mailSettings
+  newUsers' config us'
 ------------------------------------------------------------------------
 newUserQuick :: (MonadRandom m)
              => Text -> m (NewUser GargPassword)
@@ -54,27 +55,27 @@ guessUserName n = case splitOn "@" n of
     _       -> Nothing
 ------------------------------------------------------------------------
 newUser' :: HasNodeError err
-        => ServerAddress -> NewUser GargPassword -> Cmd err Int64
-newUser' address u = newUsers' address [u]
+        => MailConfig -> NewUser GargPassword -> Cmd err Int64
+newUser' cfg u = newUsers' cfg [u]
 
 newUsers' :: HasNodeError err
-         => ServerAddress -> [NewUser GargPassword] -> Cmd err Int64
-newUsers' address us = do
+         => MailConfig -> [NewUser GargPassword] -> Cmd err Int64
+newUsers' cfg us = do
   us' <- liftBase         $ mapM toUserHash  us
   r   <- insertUsers      $ map  toUserWrite us'
   _   <- mapM getOrMkRoot $ map  (\u -> UserName   (_nu_username u)) us
-  _   <- liftBase         $ mapM (\u -> mail address (Invitation u)) us
+  _   <- liftBase         $ mapM (\u -> mail cfg (Invitation u)) us
   printDebug "newUsers'" us
   pure r
 ------------------------------------------------------------------------
 
 updateUser :: HasNodeError err
-           => SendEmail -> Text -> NewUser GargPassword -> Cmd err Int64
-updateUser (SendEmail send) server u = do
+           => SendEmail -> MailConfig -> NewUser GargPassword -> Cmd err Int64
+updateUser (SendEmail send) cfg u = do
   u' <- liftBase     $ toUserHash   u
   n  <- updateUserDB $ toUserWrite  u'
   _  <- case send of
-     True  -> liftBase     $ mail server (PassUpdate u)
+     True  -> liftBase     $ mail cfg (PassUpdate u)
      False -> pure ()
   pure n
 

src/Gargantext/Database/Prelude.hs

@@ -21,16 +21,17 @@ import Control.Monad.Reader
 import Control.Monad.Trans.Control (MonadBaseControl)
 import Data.Aeson (Result(Error,Success), fromJSON, FromJSON)
 import Data.ByteString.Char8 (hPutStrLn)
-import Data.Either.Extra (Either(Left, Right))
-import Data.Ini (readIniFile, lookupValue)
+import Data.Either.Extra (Either)
 import Data.Pool (Pool, withResource)
 import Data.Profunctor.Product.Default (Default)
-import Data.Text (unpack, pack, Text)
+import Data.Text (unpack, Text)
 import Data.Word (Word16)
 import Database.PostgreSQL.Simple (Connection, connect)
 import Database.PostgreSQL.Simple.FromField ( Conversion, ResultError(ConversionFailed), fromField, returnError)
 import Database.PostgreSQL.Simple.Internal  (Field)
+import Gargantext.Core.Mail.Types (HasMail)
 import Gargantext.Prelude
+import Gargantext.Prelude.Config (readIniFile', val)
 import Opaleye (Query, Unpackspec, showSql, FromFields, Select, runSelect, PGJsonb, DefaultFromField)
 import Opaleye.Aggregate (countRows)
 import System.IO (FilePath)
@@ -77,6 +78,7 @@ type CmdM env err m =
   ( CmdM'             env err m
   , HasConnectionPool env
   , HasConfig         env
+  , HasMail           env
   )
 
 type CmdRandom env err m =
@@ -84,6 +86,7 @@ type CmdRandom env err m =
   , HasConnectionPool env
   , HasConfig         env
   , MonadRandom       m
+  , HasMail           env
   )
 
 type Cmd'' env err a = forall m.     CmdM''    env err m => m a
@@ -157,20 +160,14 @@ execPGSQuery q a = mkCmd $ \conn -> PGS.execute conn q a
 
 databaseParameters :: FilePath -> IO PGS.ConnectInfo
 databaseParameters fp = do
-  ini         <- readIniFile fp
-  let ini'' = case ini of
-        Left e     -> panic (pack $ "No ini file error" <> show e)
-        Right ini' -> ini'
-
-  let val x = case (lookupValue (pack "database") (pack x) ini'') of
-        Left _ -> panic (pack $ "no" <> x)
-        Right p' -> unpack p'
-
-  pure $ PGS.ConnectInfo { PGS.connectHost     = val       "DB_HOST"
-                         , PGS.connectPort     = read (val "DB_PORT") :: Word16
-                         , PGS.connectUser     = val       "DB_USER"
-                         , PGS.connectPassword = val       "DB_PASS"
-                         , PGS.connectDatabase = val       "DB_NAME"
+  ini <- readIniFile' fp
+  let val' key = unpack $ val ini "database" key
+
+  pure $ PGS.ConnectInfo { PGS.connectHost     = val' "DB_HOST"
+                         , PGS.connectPort     = read (val' "DB_PORT") :: Word16
+                         , PGS.connectUser     = val' "DB_USER"
+                         , PGS.connectPassword = val' "DB_PASS"
+                         , PGS.connectDatabase = val' "DB_NAME"
                          }
 
 connectGargandb :: FilePath -> IO Connection

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

@@ -17,10 +17,9 @@ Portability : POSIX
 {-# LANGUAGE TemplateHaskell            #-}
 
 module Gargantext.Database.Query.Table.NodesNgramsRepo
-  ( module Gargantext.Database.Schema.NodesNgramsRepo
-  )
   where
 
+{-
 import Gargantext.Database.Schema.Prelude
 import Gargantext.API.Ngrams (NgramsStatePatch)
 import Gargantext.Database.Schema.NodesNgramsRepo
@@ -42,4 +41,4 @@ _insertRepos ns = mkCmd $ \conn -> runInsert_ conn $ Insert repoTable (toWrite n
     toWrite :: [NgramsStatePatch] -> [RepoDbWrite]
     toWrite = undefined
     --ns' = map (\(RepoDbNgrams v ps) -> RepoDbWrite (sqlInt4 v) (pgJSONB ps)) ns
-
+-}

src/Gargantext/Database/Schema/NodesNgramsRepo.hs

@@ -21,10 +21,11 @@ Portability : POSIX
 module Gargantext.Database.Schema.NodesNgramsRepo
   where
 
+{-
 import Data.Map.Strict.Patch (PatchMap)
 
 import Gargantext.Database.Schema.Prelude
-import Gargantext.API.Ngrams.Types (NgramsStatePatch, NgramsTablePatch)
+import Gargantext.API.Ngrams.Types (NgramsTablePatch)
 import Gargantext.Database.Schema.Ngrams (NgramsType)
 import Gargantext.Database.Admin.Types.Node (NodeId)
 import Gargantext.Prelude
@@ -59,4 +60,4 @@ repoTable = Table "nodes_ngrams_repo"
                    , _rdp_patches = requiredTableField "patches"
                    }
     )
-
+-}

stack.yaml

@@ -27,9 +27,8 @@ allow-newer: true
 #  "$everything": -haddock
 
 extra-deps:
-- #git: https://gitlab.iscpif.fr/gargantext/haskell-gargantext-prelude.git
-  git: https://gitlab.iscpif.fr/cgenie/haskell-gargantext-prelude.git
-  commit: 35b09629a658fc16cc9ff63e7591e58511cd98a7
+- git: https://gitlab.iscpif.fr/gargantext/haskell-gargantext-prelude.git
+  commit: 6bfdb29e9a576472c7fd7ebe648ad101e5b3927f
   # Data Mining Libs
 - git: https://github.com/delanoe/data-time-segment.git
   commit: 10a416b9f6c443866b36479c3441ebb3bcdeb7ef