Commit 8285f7d3 authored by Alexandre Delanoë's avatar Alexandre Delanoë

[ADMIN] log instructions by email

parent 00900141
...@@ -204,7 +204,7 @@ flowCorpusUser l user corpusName ctype ids = do ...@@ -204,7 +204,7 @@ flowCorpusUser l user corpusName ctype ids = do
-- User Flow -- User Flow
(userId, _rootId, userCorpusId) <- getOrMk_RootWithCorpus user corpusName ctype (userId, _rootId, userCorpusId) <- getOrMk_RootWithCorpus user corpusName ctype
listId <- getOrMkList userCorpusId userId listId <- getOrMkList userCorpusId userId
_cooc <- insertDefaultNode NodeListCooc listId userId -- _cooc <- insertDefaultNode NodeListCooc listId userId
-- TODO: check if present already, ignore -- TODO: check if present already, ignore
_ <- Doc.add userCorpusId ids _ <- Doc.add userCorpusId ids
...@@ -286,7 +286,7 @@ insertMasterDocs c lang hs = do ...@@ -286,7 +286,7 @@ insertMasterDocs c lang hs = do
, (nId, w) <- Map.toList mapNodeIdWeight , (nId, w) <- Map.toList mapNodeIdWeight
] ]
_cooc <- insertDefaultNode NodeListCooc lId masterUserId -- _cooc <- insertDefaultNode NodeListCooc lId masterUserId
-- to be removed -- to be removed
_ <- insertDocNgrams lId indexedNgrams _ <- insertDocNgrams lId indexedNgrams
pure ids' pure ids'
......
...@@ -15,27 +15,62 @@ module Gargantext.Database.Action.User ...@@ -15,27 +15,62 @@ module Gargantext.Database.Action.User
where where
-- import Data.Maybe (catMaybes) -- import Data.Maybe (catMaybes)
import Data.Text (Text, unlines)
import Gargantext.Database.Query.Table.User import Gargantext.Database.Query.Table.User
import Gargantext.Core.Types.Individu import Gargantext.Core.Types.Individu
import Gargantext.Database.Prelude import Gargantext.Database.Prelude
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.Prelude.Mail (gargMail) import Gargantext.Prelude.Mail (gargMail, GargMail(..))
import Gargantext.Database.Query.Table.Node.Error (HasNodeError(..), nodeError, NodeError(..)) import Gargantext.Database.Query.Table.Node.Error (HasNodeError(..), nodeError, NodeError(..))
import Gargantext.Database.Action.Flow (getOrMkRoot) import Gargantext.Database.Action.Flow (getOrMkRoot)
------------------------------------------------------------------------ ------------------------------------------------------------------------
mkUser :: HasNodeError err => NewUser GargPassword -> Cmd err Int64 mkUser :: HasNodeError err => Text -> NewUser GargPassword -> Cmd err Int64
mkUser u = mkUsers [u] mkUser address u = mkUsers address [u]
mkUsers :: HasNodeError err => [NewUser GargPassword] -> Cmd err Int64 mkUsers :: HasNodeError err => Text -> [NewUser GargPassword] -> Cmd err Int64
mkUsers us = do mkUsers address us = do
us' <- liftBase $ mapM toUserHash us us' <- liftBase $ mapM toUserHash us
r <- insertUsers $ map toUserWrite us' r <- insertUsers $ map toUserWrite us'
_ <- mapM getOrMkRoot $ map (\u -> UserName (_nu_username u)) us _ <- mapM getOrMkRoot $ map (\u -> UserName (_nu_username u)) us
_ <- liftBase gargMail _ <- liftBase $ mapM (mail address) us
pure r pure r
------------------------------------------------------------------------
-- TODO gargantext.ini config
mail :: Text -> NewUser GargPassword -> IO ()
mail address nu@(NewUser u m _) = gargMail (GargMail m (Just u) subject body)
where
subject = "[Your Garg Account]"
body = logInstructions address nu
-- TODO put this in a configurable file (path in gargantext.ini)
logInstructions :: Text -> NewUser GargPassword -> Text
logInstructions address (NewUser u _ (GargPassword p)) =
unlines [ "Hello"
, "You have been invited to test the new GarganText platform!"
, ""
, "You can log on to: " <> address
, "Your login is: " <> u
, "Your password is: " <> p
, ""
, "Please read the full terms of use on:"
, "https://gitlab.iscpif.fr/humanities/tofu/tree/master"
, ""
, "Your feedback will be valuable for further development"
, "of the platform, do not hesitate to contact us and"
, "to contribute on our forum:"
, " https://discourse.iscpif.fr/c/gargantext"
, ""
, "With our best regards,"
, "-- "
, "The Gargantext Team (CNRS)"
]
------------------------------------------------------------------------
------------------------------------------------------------------------ ------------------------------------------------------------------------
rmUser :: HasNodeError err => User -> Cmd err Int64 rmUser :: HasNodeError err => User -> Cmd err Int64
rmUser (UserName un) = deleteUsers [un] rmUser (UserName un) = deleteUsers [un]
......
...@@ -12,26 +12,35 @@ Portability : POSIX ...@@ -12,26 +12,35 @@ Portability : POSIX
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
module Gargantext.Prelude.Mail module Gargantext.Prelude.Mail
(gargMail) (gargMail, GargMail(..))
where where
-- import Data.Text.Internal.Lazy (Text)
import Data.Text (Text)
import Data.Maybe import Data.Maybe
import Network.Mail.SMTP hiding (htmlPart) import Network.Mail.SMTP hiding (htmlPart)
import Gargantext.Prelude import Gargantext.Prelude
import Network.Mail.Mime (plainPart) import Network.Mail.Mime (plainPart)
-- | TODO add parameters type Email = Text
gargMail :: IO () type Name = Text
gargMail = sendMail "localhost" mail
data GargMail = GargMail { gm_to :: Email
, gm_name :: Maybe Name
, gm_subject :: Text
, gm_body :: Text
}
-- | TODO add parameters to gargantext.ini
gargMail :: GargMail -> IO ()
gargMail (GargMail to' name subject body) = sendMail "localhost" mail
where where
mail = simpleMail from to cc bcc subject [body] mail = simpleMail from to cc bcc subject [plainPart $ cs body]
from = Address (Just "François Rabelais") "francois.rabelais@gargantext.org" from = Address (Just "GargTeam") "contact@gargantext.org"
to = [Address (Just "Anoe") "alexandre@localhost"] to = [Address name to']
cc = [] cc = []
bcc = [] bcc = []
subject = "email subject"
body = plainPart "email body"
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment