Skip to content
Projects
Groups
Snippets
Help
Loading...
Help
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
haskell-gargantext
Project
Project
Details
Activity
Releases
Cycle Analytics
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Charts
Issues
157
Issues
157
List
Board
Labels
Milestones
Merge Requests
9
Merge Requests
9
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Charts
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Charts
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
gargantext
haskell-gargantext
Commits
fcc758e8
Commit
fcc758e8
authored
Nov 18, 2021
by
Alexandre Delanoë
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[FIX] url in body is the url of the website not the smtp one
parent
6ff147ad
Changes
3
Hide whitespace changes
Inline
Side-by-side
Showing
3 changed files
with
15 additions
and
10 deletions
+15
-10
Mail.hs
src/Gargantext/Core/Mail.hs
+11
-6
Mail.hs
src/Gargantext/Database/Action/Mail.hs
+2
-2
New.hs
src/Gargantext/Database/Action/User/New.hs
+2
-2
No files found.
src/Gargantext/Core/Mail.hs
View file @
fcc758e8
...
@@ -11,12 +11,15 @@ Portability : POSIX
...
@@ -11,12 +11,15 @@ Portability : POSIX
module
Gargantext.Core.Mail
where
module
Gargantext.Core.Mail
where
import
Control.Lens
(
(
^.
)
)
import
Control.Lens
(
view
)
import
Data.Text
(
Text
,
unlines
,
splitOn
)
import
Data.Text
(
Text
,
unlines
,
splitOn
)
import
Gargantext.Core.Types.Individu
import
Gargantext.Core.Types.Individu
import
Gargantext.Prelude
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
(
gargMail
,
GargMail
(
..
))
import
Gargantext.Prelude.Mail.Types
(
MailConfig
,
mc_mail_host
)
import
Gargantext.Prelude.Mail.Types
(
MailConfig
)
import
qualified
Data.List
as
List
import
qualified
Data.List
as
List
...
@@ -38,12 +41,14 @@ data MailModel = Invitation { invitation_user :: NewUser GargPassword }
...
@@ -38,12 +41,14 @@ data MailModel = Invitation { invitation_user :: NewUser GargPassword }
}
}
------------------------------------------------------------------------
------------------------------------------------------------------------
------------------------------------------------------------------------
------------------------------------------------------------------------
mail
::
MailConfig
->
MailModel
->
IO
()
mail
::
(
CmdM
env
err
m
)
=>
MailConfig
->
MailModel
->
m
()
mail
cfg
model
=
gargMail
cfg
(
GargMail
m
(
Just
u
)
subject
body
)
mail
mailCfg
model
=
do
where
cfg
<-
view
hasConfig
let
(
m
,
u
)
=
email_to
model
(
m
,
u
)
=
email_to
model
subject
=
email_subject
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
emailWith
::
ServerAddress
->
MailModel
->
Text
...
...
src/Gargantext/Database/Action/Mail.hs
View file @
fcc758e8
...
@@ -25,10 +25,10 @@ import Gargantext.Prelude
...
@@ -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
sendMail
u
=
do
cfg
<-
view
$
mailSettings
cfg
<-
view
$
mailSettings
userLight
<-
getUserLightDB
u
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
})
,
mailInfo_address
=
userLight_email
userLight
})
src/Gargantext/Database/Action/User/New.hs
View file @
fcc758e8
...
@@ -64,7 +64,7 @@ newUsers' cfg us = do
...
@@ -64,7 +64,7 @@ newUsers' cfg 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
$
mapM
(
\
u
->
mail
cfg
(
Invitation
u
))
us
_
<-
mapM
(
\
u
->
mail
cfg
(
Invitation
u
))
us
printDebug
"newUsers'"
us
printDebug
"newUsers'"
us
pure
r
pure
r
------------------------------------------------------------------------
------------------------------------------------------------------------
...
@@ -75,7 +75,7 @@ updateUser (SendEmail send) cfg u = do
...
@@ -75,7 +75,7 @@ updateUser (SendEmail send) cfg u = do
u'
<-
liftBase
$
toUserHash
u
u'
<-
liftBase
$
toUserHash
u
n
<-
updateUserDB
$
toUserWrite
u'
n
<-
updateUserDB
$
toUserWrite
u'
_
<-
case
send
of
_
<-
case
send
of
True
->
liftBase
$
mail
cfg
(
PassUpdate
u
)
True
->
mail
cfg
(
PassUpdate
u
)
False
->
pure
()
False
->
pure
()
pure
n
pure
n
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment