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
-- User Flow
(userId, _rootId, userCorpusId) <- getOrMk_RootWithCorpus user corpusName ctype
listId <- getOrMkList userCorpusId userId
_cooc <- insertDefaultNode NodeListCooc listId userId
-- _cooc <- insertDefaultNode NodeListCooc listId userId
-- TODO: check if present already, ignore
_ <- Doc.add userCorpusId ids
......@@ -286,7 +286,7 @@ insertMasterDocs c lang hs = do
, (nId, w) <- Map.toList mapNodeIdWeight
]
_cooc <- insertDefaultNode NodeListCooc lId masterUserId
-- _cooc <- insertDefaultNode NodeListCooc lId masterUserId
-- to be removed
_ <- insertDocNgrams lId indexedNgrams
pure ids'
......
......@@ -15,27 +15,62 @@ module Gargantext.Database.Action.User
where
-- import Data.Maybe (catMaybes)
import Data.Text (Text, unlines)
import Gargantext.Database.Query.Table.User
import Gargantext.Core.Types.Individu
import Gargantext.Database.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.Action.Flow (getOrMkRoot)
------------------------------------------------------------------------
mkUser :: HasNodeError err => NewUser GargPassword -> Cmd err Int64
mkUser u = mkUsers [u]
mkUser :: HasNodeError err => Text -> NewUser GargPassword -> Cmd err Int64
mkUser address u = mkUsers address [u]
mkUsers :: HasNodeError err => [NewUser GargPassword] -> Cmd err Int64
mkUsers us = do
mkUsers :: HasNodeError err => Text -> [NewUser GargPassword] -> Cmd err Int64
mkUsers address us = do
us' <- liftBase $ mapM toUserHash us
r <- insertUsers $ map toUserWrite us'
_ <- mapM getOrMkRoot $ map (\u -> UserName (_nu_username u)) us
_ <- liftBase gargMail
_ <- liftBase $ mapM (mail address) us
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 (UserName un) = deleteUsers [un]
......
......@@ -12,26 +12,35 @@ Portability : POSIX
{-# LANGUAGE OverloadedStrings #-}
module Gargantext.Prelude.Mail
(gargMail)
(gargMail, GargMail(..))
where
-- import Data.Text.Internal.Lazy (Text)
import Data.Text (Text)
import Data.Maybe
import Network.Mail.SMTP hiding (htmlPart)
import Gargantext.Prelude
import Network.Mail.Mime (plainPart)
-- | TODO add parameters
gargMail :: IO ()
gargMail = sendMail "localhost" mail
type Email = Text
type Name = Text
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
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"
to = [Address (Just "Anoe") "alexandre@localhost"]
from = Address (Just "GargTeam") "contact@gargantext.org"
to = [Address name to']
cc = []
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