Skip to content
Projects
Groups
Snippets
Help
Loading...
Help
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
H
haskell-gargantext
Project
Project
Details
Activity
Releases
Cycle Analytics
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Charts
Issues
0
Issues
0
List
Board
Labels
Milestones
Merge Requests
0
Merge Requests
0
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
Przemyslaw Kaminski
haskell-gargantext
Commits
c8b38fb4
Commit
c8b38fb4
authored
Sep 24, 2020
by
Przemyslaw Kaminski
Browse files
Options
Browse Files
Download
Plain Diff
Merge branch 'dev' into dev-debian-install-script
parents
15ba4314
74baff14
Changes
1
Hide whitespace changes
Inline
Side-by-side
Showing
1 changed file
with
38 additions
and
5 deletions
+38
-5
User.hs
src/Gargantext/Database/Action/User.hs
+38
-5
No files found.
src/Gargantext/Database/Action/User.hs
View file @
c8b38fb4
...
...
@@ -33,23 +33,32 @@ mkUsers address us = do
us'
<-
liftBase
$
mapM
toUserHash
us
r
<-
insertUsers
$
map
toUserWrite
us'
_
<-
mapM
getOrMkRoot
$
map
(
\
u
->
UserName
(
_nu_username
u
))
us
_
<-
liftBase
$
mapM
(
mail
address
)
us
_
<-
liftBase
$
mapM
(
mail
Invitation
address
)
us
pure
r
------------------------------------------------------------------------
updateUser
::
HasNodeError
err
=>
Text
->
NewUser
GargPassword
->
Cmd
err
Int64
updateUser
address
u
=
do
u'
<-
liftBase
$
toUserHash
u
n
<-
updateUserDB
$
toUserWrite
u'
_
<-
liftBase
$
mail
address
u
_
<-
liftBase
$
mail
Update
address
u
pure
n
------------------------------------------------------------------------
data
Mail
=
Invitation
|
Update
-- TODO gargantext.ini config
mail
::
Text
->
NewUser
GargPassword
->
IO
()
mail
address
nu
@
(
NewUser
u
m
_
)
=
gargMail
(
GargMail
m
(
Just
u
)
subject
body
)
mail
::
Mail
->
Text
->
NewUser
GargPassword
->
IO
()
mail
mtype
address
nu
@
(
NewUser
u
m
_
)
=
gargMail
(
GargMail
m
(
Just
u
)
subject
body
)
where
subject
=
"[Your Garg Account]"
body
=
logInstructions
address
nu
body
=
bodyWith
mtype
address
nu
bodyWith
::
Mail
->
Text
->
NewUser
GargPassword
->
Text
bodyWith
Invitation
add
nu
=
logInstructions
add
nu
bodyWith
Update
add
nu
=
updateInstructions
add
nu
-- TODO put this in a configurable file (path in gargantext.ini)
logInstructions
::
Text
->
NewUser
GargPassword
->
Text
...
...
@@ -74,6 +83,30 @@ logInstructions address (NewUser u _ (GargPassword p)) =
,
"The Gargantext Team (CNRS)"
]
updateInstructions
::
Text
->
NewUser
GargPassword
->
Text
updateInstructions
address
(
NewUser
u
_
(
GargPassword
p
))
=
unlines
[
"Hello"
,
"Your account have been updated on the GarganText platform!"
,
""
,
"You can log on to: "
<>
address
,
"Your login is: "
<>
u
,
"Your password is: "
<>
p
,
""
,
"As reminder, please read the full terms of use on:"
,
"https://gitlab.iscpif.fr/humanities/tofu/tree/master"
,
""
,
"Your feedback is always 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
]
...
...
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