]> Git — Sourcephile - gargantext.git/blob - src/Gargantext/API/GraphQL/UserInfo.hs
[FIX] commenting to fix graph issue
[gargantext.git] / src / Gargantext / API / GraphQL / UserInfo.hs
1 {-# LANGUAGE DeriveAnyClass #-}
2 {-# LANGUAGE DuplicateRecordFields #-}
3
4 module Gargantext.API.GraphQL.UserInfo where
5
6 import Control.Lens
7 import Data.Maybe (fromMaybe)
8 import Data.Morpheus.Types
9 ( GQLType
10 , Resolver
11 , ResolverM
12 , QUERY
13 , lift
14 )
15 import Data.Text (Text)
16 import qualified Data.Text as T
17 import Gargantext.API.Prelude (GargM, GargError)
18 import Gargantext.Core.Mail.Types (HasMail)
19 import Gargantext.Database.Admin.Types.Hyperdata
20 ( HyperdataUser(..)
21 , hc_source
22 , hc_title
23 , hu_shared)
24 import Gargantext.Database.Admin.Types.Hyperdata.Contact
25 ( HyperdataContact
26 , ContactWho
27 , ContactWhere
28 , cw_city
29 , cw_country
30 , cw_firstName
31 , cw_lastName
32 , cw_labTeamDepts
33 , cw_office
34 , cw_organization
35 , cw_role
36 , cw_touch
37 , cw_description
38 , ct_mail
39 , ct_phone
40 , hc_who
41 , hc_where)
42 import Gargantext.Database.Prelude (HasConnectionPool, HasConfig)
43 import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata)
44 import Gargantext.Database.Query.Table.User (getUsersWithHyperdata, getUsersWithNodeHyperdata, updateUserEmail)
45 import Gargantext.Database.Schema.User (UserLight(..))
46 import Gargantext.Database.Schema.Node (node_id, node_hyperdata, NodePoly (Node, _node_id))
47 import Gargantext.Prelude
48 import GHC.Generics (Generic)
49 import Gargantext.API.GraphQL.Utils (AuthStatus(Invalid, Valid), authUser)
50 import Gargantext.API.Admin.Types (HasSettings)
51
52 data UserInfo = UserInfo
53 { ui_id :: Int
54 , ui_username :: Text
55 , ui_email :: Text
56 , ui_title :: Maybe Text
57 , ui_source :: Maybe Text
58 , ui_cwFirstName :: Maybe Text
59 , ui_cwLastName :: Maybe Text
60 , ui_cwCity :: Maybe Text
61 , ui_cwCountry :: Maybe Text
62 , ui_cwOrganization :: [Text]
63 , ui_cwLabTeamDepts :: [Text]
64 , ui_cwOffice :: Maybe Text
65 , ui_cwRole :: Maybe Text
66 , ui_cwTouchPhone :: Maybe Text
67 , ui_cwTouchMail :: Maybe Text -- TODO: Remove. userLight_email should be used instead
68 , ui_cwDescription :: Maybe Text
69 }
70 deriving (Generic, GQLType, Show)
71
72 -- | Arguments to the "user info" query.
73 data UserInfoArgs
74 = UserInfoArgs
75 { user_id :: Int
76 } deriving (Generic, GQLType)
77
78 -- | Arguments to the "user info" mutation,
79 data UserInfoMArgs
80 = UserInfoMArgs
81 { ui_id :: Int
82 , token :: Text
83 , ui_username :: Maybe Text
84 , ui_email :: Maybe Text
85 , ui_title :: Maybe Text
86 , ui_source :: Maybe Text
87 , ui_cwFirstName :: Maybe Text
88 , ui_cwLastName :: Maybe Text
89 , ui_cwCity :: Maybe Text
90 , ui_cwCountry :: Maybe Text
91 , ui_cwOrganization :: Maybe [Text]
92 , ui_cwLabTeamDepts :: Maybe [Text]
93 , ui_cwOffice :: Maybe Text
94 , ui_cwRole :: Maybe Text
95 , ui_cwTouchPhone :: Maybe Text
96 , ui_cwTouchMail :: Maybe Text
97 , ui_cwDescription :: Maybe Text
98 } deriving (Generic, GQLType)
99
100 type GqlM e env = Resolver QUERY e (GargM env GargError)
101 type GqlM' e env err = ResolverM e (GargM env err) Int
102
103 -- | Function to resolve user from a query.
104 resolveUserInfos
105 :: (HasConnectionPool env, HasConfig env, HasMail env)
106 => UserInfoArgs -> GqlM e env [UserInfo]
107 resolveUserInfos UserInfoArgs { user_id } = dbUsers user_id
108
109 -- | Mutation for user info
110 updateUserInfo
111 :: (HasConnectionPool env, HasConfig env, HasMail env, HasSettings env)
112 -- => UserInfoMArgs -> ResolverM e (GargM env err) Int
113 => UserInfoMArgs -> GqlM' e env err
114 updateUserInfo (UserInfoMArgs { ui_id, .. }) = do
115 -- lift $ printDebug "[updateUserInfo] ui_id" ui_id
116 users <- lift (getUsersWithNodeHyperdata ui_id)
117 case users of
118 [] -> panic $ "[updateUserInfo] User with id " <> (T.pack $ show ui_id) <> " doesn't exist."
119 ((UserLight { .. }, node_u):_) -> do
120 testAuthUser <- lift $ authUser (nId node_u) token
121 case testAuthUser of
122 Invalid -> panic "[updateUserInfo] failed to validate user"
123 Valid -> do
124 let u_hyperdata = node_u ^. node_hyperdata
125 -- lift $ printDebug "[updateUserInfo] u" u
126 let u_hyperdata' = uh ui_titleL ui_title $
127 uh ui_sourceL ui_source $
128 uh ui_cwFirstNameL ui_cwFirstName $
129 uh ui_cwLastNameL ui_cwLastName $
130 uh ui_cwCityL ui_cwCity $
131 uh ui_cwCountryL ui_cwCountry $
132 uh' ui_cwLabTeamDeptsL ui_cwLabTeamDepts $
133 uh' ui_cwOrganizationL ui_cwOrganization $
134 uh ui_cwOfficeL ui_cwOffice $
135 uh ui_cwRoleL ui_cwRole $
136 uh ui_cwTouchMailL ui_cwTouchMail $
137 uh ui_cwTouchPhoneL ui_cwTouchPhone $
138 uh ui_cwDescriptionL ui_cwDescription
139 u_hyperdata
140 -- NOTE: We have 1 username and 2 emails: userLight_email and ui_cwTouchMail
141 -- The userLight_email is more important: it is used for login and sending mail.
142 -- Therefore we update ui_cwTouchMail and userLight_email.
143 -- ui_cwTouchMail is to be removed in the future.
144 let u' = UserLight { userLight_email = fromMaybe userLight_email $ view ui_cwTouchMailL u_hyperdata
145 , .. }
146 -- lift $ printDebug "[updateUserInfo] with firstName" u_hyperdata'
147 _ <- lift $ updateHyperdata (node_u ^. node_id) u_hyperdata'
148 _ <- lift $ updateUserEmail u'
149 --let _newUser = toUser (u, u_hyperdata')
150 pure 1
151 where
152 uh _ Nothing u_hyperdata = u_hyperdata
153 uh lens' (Just val) u_hyperdata = u_hyperdata & lens' .~ Just val
154 uh' _ Nothing u_hyperdata = u_hyperdata
155 uh' lens' (Just val) u_hyperdata = u_hyperdata & lens' .~ val
156 nId Node {_node_id} = _node_id
157
158 -- | Inner function to fetch the user from DB.
159 dbUsers
160 :: (HasConnectionPool env, HasConfig env, HasMail env)
161 => Int -> GqlM e env [UserInfo]
162 dbUsers user_id = do
163 -- lift $ printDebug "[dbUsers]" user_id
164 -- user <- getUsersWithId user_id
165 -- hyperdata <- getUserHyperdata user_id
166 -- lift (map toUser <$> zip user hyperdata)
167 lift (map toUser <$> (getUsersWithHyperdata user_id))
168
169 toUser :: (UserLight, HyperdataUser) -> UserInfo
170 toUser (UserLight { .. }, u_hyperdata) =
171 UserInfo { ui_id = userLight_id
172 , ui_username = userLight_username
173 , ui_email = userLight_email
174 , ui_title = u_hyperdata ^. ui_titleL
175 , ui_source = u_hyperdata ^. ui_sourceL
176 , ui_cwFirstName = u_hyperdata ^. ui_cwFirstNameL
177 , ui_cwLastName = u_hyperdata ^. ui_cwLastNameL
178 , ui_cwCity = u_hyperdata ^. ui_cwCityL
179 , ui_cwCountry = u_hyperdata ^. ui_cwCountryL
180 , ui_cwLabTeamDepts = u_hyperdata ^. ui_cwLabTeamDeptsL
181 , ui_cwOrganization = u_hyperdata ^. ui_cwOrganizationL
182 , ui_cwOffice = u_hyperdata ^. ui_cwOfficeL
183 , ui_cwRole = u_hyperdata ^. ui_cwRoleL
184 --, ui_cwTouchMail = u_hyperdata ^. ui_cwTouchMailL
185 , ui_cwTouchMail = Just userLight_email
186 , ui_cwTouchPhone = u_hyperdata ^. ui_cwTouchPhoneL
187 , ui_cwDescription = u_hyperdata ^. ui_cwDescriptionL }
188
189 sharedL :: Traversal' HyperdataUser HyperdataContact
190 sharedL = hu_shared . _Just
191 ui_titleL :: Traversal' HyperdataUser (Maybe Text)
192 ui_titleL = sharedL . hc_title
193 ui_sourceL :: Traversal' HyperdataUser (Maybe Text)
194 ui_sourceL = sharedL . hc_source
195 contactWhoL :: Traversal' HyperdataUser ContactWho
196 contactWhoL = sharedL . hc_who . _Just
197 ui_cwFirstNameL :: Traversal' HyperdataUser (Maybe Text)
198 ui_cwFirstNameL = contactWhoL . cw_firstName
199 ui_cwLastNameL :: Traversal' HyperdataUser (Maybe Text)
200 ui_cwLastNameL = contactWhoL . cw_lastName
201 contactWhereL :: Traversal' HyperdataUser ContactWhere
202 contactWhereL = sharedL . hc_where . (ix 0)
203 ui_cwCityL :: Traversal' HyperdataUser (Maybe Text)
204 ui_cwCityL = contactWhereL . cw_city
205 ui_cwCountryL :: Traversal' HyperdataUser (Maybe Text)
206 ui_cwCountryL = contactWhereL . cw_country
207 ui_cwLabTeamDeptsL :: Traversal' HyperdataUser [Text]
208 ui_cwLabTeamDeptsL = hu_shared . _Just . (hc_where . (ix 0) . cw_labTeamDepts)
209 ui_cwOrganizationL :: Traversal' HyperdataUser [Text]
210 ui_cwOrganizationL = hu_shared . _Just . (hc_where . (ix 0) . cw_organization)
211 ui_cwOfficeL :: Traversal' HyperdataUser (Maybe Text)
212 ui_cwOfficeL = contactWhereL . cw_office
213 ui_cwRoleL :: Traversal' HyperdataUser (Maybe Text)
214 ui_cwRoleL = contactWhereL . cw_role
215 ui_cwTouchMailL :: Traversal' HyperdataUser (Maybe Text)
216 ui_cwTouchMailL = hu_shared . _Just . (hc_where . (ix 0) . cw_touch . _Just . ct_mail)
217 --ui_cwTouchMailL = contactWhereL . cw_touch . _Just . ct_mail
218 ui_cwTouchPhoneL :: Traversal' HyperdataUser (Maybe Text)
219 ui_cwTouchPhoneL = hu_shared . _Just . (hc_where . (ix 0) . cw_touch . _Just . ct_phone)
220 --ui_cwTouchPhoneL = contactWhereL . cw_touch . _Just . ct_phone
221 ui_cwDescriptionL :: Traversal' HyperdataUser (Maybe Text)
222 ui_cwDescriptionL = contactWhoL . cw_description