Commit fcc758e8 authored by Alexandre Delanoë's avatar Alexandre Delanoë

[FIX] url in body is the url of the website not the smtp one

parent 6ff147ad
......@@ -11,12 +11,15 @@ Portability : POSIX
module Gargantext.Core.Mail where
import Control.Lens ((^.))
import Control.Lens (view)
import Data.Text (Text, unlines, splitOn)
import Gargantext.Core.Types.Individu
import Gargantext.Prelude
import Gargantext.Prelude.Config (gc_url)
import Gargantext.Database.Prelude
-- import Gargantext.Prelude.Config (gc_url)
import Gargantext.Prelude.Mail (gargMail, GargMail(..))
import Gargantext.Prelude.Mail.Types (MailConfig, mc_mail_host)
import Gargantext.Prelude.Mail.Types (MailConfig)
import qualified Data.List as List
......@@ -38,12 +41,14 @@ data MailModel = Invitation { invitation_user :: NewUser GargPassword }
}
------------------------------------------------------------------------
------------------------------------------------------------------------
mail :: MailConfig -> MailModel -> IO ()
mail cfg model = gargMail cfg (GargMail m (Just u) subject body)
where
mail :: (CmdM env err m) => MailConfig -> MailModel -> m ()
mail mailCfg model = do
cfg <- view hasConfig
let
(m,u) = email_to model
subject = email_subject model
body = emailWith (cfg ^. mc_mail_host) model
body = emailWith (view gc_url cfg) model
liftBase $ gargMail mailCfg (GargMail m (Just u) subject body)
------------------------------------------------------------------------
emailWith :: ServerAddress -> MailModel -> Text
......
......@@ -25,10 +25,10 @@ import Gargantext.Prelude
------------------------------------------------------------------------
sendMail :: HasNodeError err => User -> Cmd err ()
sendMail :: (HasNodeError err, CmdM env err m) => User -> m ()
sendMail u = do
cfg <- view $ mailSettings
userLight <- getUserLightDB u
liftBase $ mail cfg (MailInfo { mailInfo_username = userLight_username userLight
mail cfg (MailInfo { mailInfo_username = userLight_username userLight
, mailInfo_address = userLight_email userLight })
......@@ -64,7 +64,7 @@ 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 cfg (Invitation u)) us
_ <- mapM (\u -> mail cfg (Invitation u)) us
printDebug "newUsers'" us
pure r
------------------------------------------------------------------------
......@@ -75,7 +75,7 @@ updateUser (SendEmail send) cfg u = do
u' <- liftBase $ toUserHash u
n <- updateUserDB $ toUserWrite u'
_ <- case send of
True -> liftBase $ mail cfg (PassUpdate u)
True -> mail cfg (PassUpdate u)
False -> pure ()
pure n
......
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