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
02ccff83
Commit
02ccff83
authored
Mar 24, 2022
by
Przemyslaw Kaminski
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[user] update userLight_email on user info page
The ui_cwTouchMail is not used, it should be removed in the future.
parent
01be6e4a
Changes
3
Hide whitespace changes
Inline
Side-by-side
Showing
3 changed files
with
29 additions
and
5 deletions
+29
-5
UserInfo.hs
src/Gargantext/API/GraphQL/UserInfo.hs
+16
-4
Mail.hs
src/Gargantext/Core/Mail.hs
+1
-1
User.hs
src/Gargantext/Database/Query/Table/User.hs
+12
-0
No files found.
src/Gargantext/API/GraphQL/UserInfo.hs
View file @
02ccff83
...
...
@@ -4,6 +4,7 @@
module
Gargantext.API.GraphQL.UserInfo
where
import
Control.Lens
import
Data.Maybe
(
fromMaybe
)
import
Data.Morpheus.Types
(
GQLType
,
Resolver
...
...
@@ -39,7 +40,7 @@ import Gargantext.Database.Admin.Types.Hyperdata.Contact
,
hc_where
)
import
Gargantext.Database.Prelude
(
HasConnectionPool
,
HasConfig
)
import
Gargantext.Database.Query.Table.Node.UpdateOpaleye
(
updateHyperdata
)
import
Gargantext.Database.Query.Table.User
(
getUsersWithHyperdata
,
getUsersWithNodeHyperdata
)
import
Gargantext.Database.Query.Table.User
(
getUsersWithHyperdata
,
getUsersWithNodeHyperdata
,
updateUserEmail
)
import
Gargantext.Database.Schema.User
(
UserLight
(
..
))
import
Gargantext.Database.Schema.Node
(
node_id
,
node_hyperdata
)
import
Gargantext.Prelude
...
...
@@ -60,7 +61,8 @@ data UserInfo = UserInfo
,
ui_cwOffice
::
Maybe
Text
,
ui_cwRole
::
Maybe
Text
,
ui_cwTouchPhone
::
Maybe
Text
,
ui_cwTouchMail
::
Maybe
Text
}
,
ui_cwTouchMail
::
Maybe
Text
-- TODO: Remove. userLight_email should be used instead
}
deriving
(
Generic
,
GQLType
,
Show
)
-- | Arguments to the "user info" query.
...
...
@@ -106,7 +108,7 @@ updateUserInfo (UserInfoMArgs { ui_id, .. }) = do
users
<-
lift
(
getUsersWithNodeHyperdata
ui_id
)
case
users
of
[]
->
panic
$
"[updateUserInfo] User with id "
<>
(
T
.
pack
$
show
ui_id
)
<>
" doesn't exist."
((
_u
,
node_u
)
:
_
)
->
do
((
UserLight
{
..
}
,
node_u
)
:
_
)
->
do
let
u_hyperdata
=
node_u
^.
node_hyperdata
-- lift $ printDebug "[updateUserInfo] u" u
let
u_hyperdata'
=
uh
ui_titleL
ui_title
$
...
...
@@ -122,8 +124,17 @@ updateUserInfo (UserInfoMArgs { ui_id, .. }) = do
uh
ui_cwTouchMailL
ui_cwTouchMail
$
uh
ui_cwTouchPhoneL
ui_cwTouchPhone
$
u_hyperdata
-- NOTE: We have 1 username and 2 emails: userLight_email and ui_cwTouchMail
-- The userLight_email is more important: it is used for login and sending mail.
-- Therefore we update ui_cwTouchMail and userLight_email.
-- ui_cwTouchMail is to be removed in the future.
let
u'
=
UserLight
{
userLight_id
,
userLight_username
,
userLight_email
=
fromMaybe
userLight_email
$
view
ui_cwTouchMailL
u_hyperdata
,
userLight_password
}
-- lift $ printDebug "[updateUserInfo] with firstName" u_hyperdata'
_
<-
lift
$
updateHyperdata
(
node_u
^.
node_id
)
u_hyperdata'
_
<-
lift
$
updateUserEmail
u'
--let _newUser = toUser (u, u_hyperdata')
pure
1
where
...
...
@@ -158,7 +169,8 @@ toUser (UserLight { .. }, u_hyperdata) =
,
ui_cwOrganization
=
u_hyperdata
^.
ui_cwOrganizationL
,
ui_cwOffice
=
u_hyperdata
^.
ui_cwOfficeL
,
ui_cwRole
=
u_hyperdata
^.
ui_cwRoleL
,
ui_cwTouchMail
=
u_hyperdata
^.
ui_cwTouchMailL
--, ui_cwTouchMail = u_hyperdata ^. ui_cwTouchMailL
,
ui_cwTouchMail
=
Just
userLight_email
,
ui_cwTouchPhone
=
u_hyperdata
^.
ui_cwTouchPhoneL
}
sharedL
::
Traversal'
HyperdataUser
HyperdataContact
...
...
src/Gargantext/Core/Mail.hs
View file @
02ccff83
...
...
@@ -62,7 +62,7 @@ emailWith server model =
email_to
::
MailModel
->
(
EmailAddress
,
Name
)
email_to
(
Invitation
user
)
=
email_to'
user
email_to
(
PassUpdate
user
)
=
email_to'
user
email_to
(
MailInfo
u
m
)
=
(
m
,
u
)
email_to
(
MailInfo
{
..
})
=
(
mailInfo_address
,
mailInfo_username
)
email_to'
::
NewUser
GargPassword
->
(
EmailAddress
,
Name
)
email_to'
(
NewUser
u
m
_
)
=
(
m
,
u
)
...
...
src/Gargantext/Database/Query/Table/User.hs
View file @
02ccff83
...
...
@@ -26,6 +26,7 @@ module Gargantext.Database.Query.Table.User
,
getUserHyperdata
,
getUsersWithHyperdata
,
getUsersWithNodeHyperdata
,
updateUserEmail
,
getUser
,
insertNewUsers
,
selectUsersLightWith
...
...
@@ -158,6 +159,17 @@ getUsersWithNodeHyperdata i = do
pure
$
zip
u
h
updateUserEmail
::
UserLight
->
Cmd
err
Int64
updateUserEmail
(
UserLight
{
..
})
=
mkCmd
$
\
c
->
runUpdate_
c
updateUserQuery
where
updateUserQuery
::
Update
Int64
updateUserQuery
=
Update
{
uTable
=
userTable
,
uUpdateWith
=
updateEasy
(
\
(
UserDB
_id
_p
_ll
_su
_un
_fn
_ln
_em
_is
_ia
_dj
)
->
UserDB
_id
_p
_ll
_su
_un
_fn
_ln
(
sqlStrictText
userLight_email
)
_is
_ia
_dj
)
,
uWhere
=
(
\
row
->
user_id
row
.==
(
sqlInt4
userLight_id
))
,
uReturning
=
rCount
}
------------------------------------------------------------------
-- | Select User with some parameters
...
...
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