[MERGE] compilation ok

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

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

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

@@ -16,10 +16,12 @@ import qualified Servant.Job.Core
 
 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
@@ -30,6 +32,7 @@ data Env = Env
   , _env_self_url  :: !BaseUrl
   , _env_scrapers  :: !ScrapersEnv
   , _env_config    :: !GargConfig
+  , _env_mail      :: !MailConfig
   }
   deriving (Generic)
 
@@ -53,6 +56,8 @@ instance HasNodeStorySaver Env where
 instance HasSettings Env where
   settings = env_settings
 
+instance HasMail Env where
+  mailSettings = env_mail
 
 
 instance Servant.Job.Core.HasEnv Env (Job JobLog JobLog) where
@@ -75,6 +80,7 @@ data DevEnv = DevEnv
   , _dev_env_config    :: !GargConfig
   , _dev_env_pool      :: !(Pool Connection)
   , _dev_env_nodeStory :: !NodeStoryEnv
+  , _dev_env_mail      :: !MailConfig
   }
 
 makeLenses ''DevEnv
@@ -98,5 +104,5 @@ instance HasNodeStoryVar DevEnv where
 instance HasNodeStorySaver DevEnv where
   hasNodeStorySaver = hasNodeStory . nse_saver
 
-
-
+instance HasMail DevEnv where
+  mailSettings = dev_env_mail

src/Gargantext/API/Admin/Settings.hs

@@ -46,6 +46,7 @@ import Gargantext.API.Admin.Types
 import Gargantext.Database.Prelude (databaseParameters)
 import Gargantext.Prelude
 -- import Gargantext.Prelude.Config (gc_repofilepath)
+import qualified Gargantext.Prelude.Mail as Mail
 
 devSettings :: FilePath -> IO Settings
 devSettings jwkFile = do
@@ -182,6 +183,7 @@ newEnv port file = do
   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'
@@ -192,6 +194,7 @@ newEnv port file = do
     , _env_scrapers  = scrapers_env
     , _env_self_url  = self_url_env
     , _env_config    = config_env
+    , _env_mail      = config_mail
     }
 
 newPool :: ConnectInfo -> IO (Pool Connection)

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)
 
@@ -40,11 +41,13 @@ withDevEnv iniPath k = do
       nodeStory_env <- readNodeStoryEnv (_gc_repofilepath cfg)
       pool    <- newPool            dbParam
       setts   <- devSettings devJwkFile
+      mail    <- Mail.readConfig iniPath
       pure $ DevEnv
         { _dev_env_pool     = pool
         , _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

@@ -96,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
@@ -274,7 +275,7 @@ newNgramsFromNgramsStatePatch p =
 
 
 
-commitStatePatch :: HasNodeStory env err m
+commitStatePatch :: (HasNodeStory env err m, HasMail env)
                  => ListId
                  ->    Versioned NgramsStatePatch'
                  -> m (Versioned NgramsStatePatch')
@@ -342,6 +343,7 @@ tableNgramsPull listId ngramsType p_version = do
 tableNgramsPut :: ( HasNodeStory env err m
                   , HasInvalidError err
                   , HasSettings env
+                  , HasMail env
                   )
                  => TabType
                  -> ListId
@@ -488,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
@@ -611,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
@@ -706,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
@@ -740,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/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/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/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

stack.yaml

@@ -28,9 +28,7 @@ allow-newer: true
 
 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: ssh://git@gitlab.iscpif.fr:20022/gargantext/gargantext-graph.git
+  commit: 6bfdb29e9a576472c7fd7ebe648ad101e5b3927f
 - git: ssh://gitolite3@delanoe.org/gargantext-graph
   commit: 294887a220460bd0c114638fff9ea53306cd2f18
   # Data Mining Libs