[FIX] removing panic with NodeStory version
[gargantext.git] / src / Gargantext / API / GraphQL / UserInfo.hs
index fd80eca8c7e71493d929086beabdac70317a516a..07d99328ce2f7b209c80bac94b49b847990efee7 100644 (file)
@@ -34,6 +34,7 @@ import Gargantext.Database.Admin.Types.Hyperdata.Contact
   , cw_organization
   , cw_role
   , cw_touch
+  , cw_description
   , ct_mail
   , ct_phone
   , hc_who
@@ -42,10 +43,11 @@ import Gargantext.Database.Prelude (HasConnectionPool, HasConfig)
 import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata)
 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.Database.Schema.Node (node_id, node_hyperdata, NodePoly (Node, _node_id))
 import Gargantext.Prelude
 import GHC.Generics (Generic)
 import Gargantext.API.GraphQL.Utils (AuthStatus(Invalid, Valid), authUser)
+import Gargantext.API.Admin.Types (HasSettings)
 
 data UserInfo = UserInfo
   { ui_id             :: Int
@@ -63,6 +65,7 @@ data UserInfo = UserInfo
   , ui_cwRole         :: Maybe Text
   , ui_cwTouchPhone   :: Maybe Text
   , ui_cwTouchMail    :: Maybe Text  -- TODO: Remove. userLight_email should be used instead
+  , ui_cwDescription  :: Maybe Text
   }
   deriving (Generic, GQLType, Show)
 
@@ -90,10 +93,12 @@ data UserInfoMArgs
     , ui_cwOffice       :: Maybe Text
     , ui_cwRole         :: Maybe Text
     , ui_cwTouchPhone   :: Maybe Text
-    , ui_cwTouchMail    :: Maybe Text 
+    , ui_cwTouchMail    :: Maybe Text
+    , ui_cwDescription  :: Maybe Text
     } deriving (Generic, GQLType)
 
 type GqlM e env = Resolver QUERY e (GargM env GargError)
+type GqlM' e env err = ResolverM e (GargM env err) Int
 
 -- | Function to resolve user from a query.
 resolveUserInfos
@@ -103,16 +108,16 @@ resolveUserInfos UserInfoArgs { user_id } = dbUsers user_id
 
 -- | Mutation for user info
 updateUserInfo
-  :: (HasConnectionPool env, HasConfig env, HasMail env)
+  :: (HasConnectionPool env, HasConfig env, HasMail env, HasSettings env)
   -- => UserInfoMArgs -> ResolverM e (GargM env err) Int
-  => UserInfoMArgs -> GqlM e env Int
+  => UserInfoMArgs -> GqlM' e env err
 updateUserInfo (UserInfoMArgs { ui_id, .. }) = do
   -- lift $ printDebug "[updateUserInfo] ui_id" ui_id
   users <- lift (getUsersWithNodeHyperdata ui_id)
   case users of
     [] -> panic $ "[updateUserInfo] User with id " <> (T.pack $ show ui_id) <> " doesn't exist."
     ((UserLight { .. }, node_u):_) -> do
-      testAuthUser <- authUser ui_id token
+      testAuthUser <- lift $ authUser (nId node_u) token
       case testAuthUser of
         Invalid -> panic "[updateUserInfo] failed to validate user"
         Valid -> do
@@ -130,15 +135,14 @@ updateUserInfo (UserInfoMArgs { ui_id, .. }) = do
                             uh ui_cwRoleL ui_cwRole $
                             uh ui_cwTouchMailL ui_cwTouchMail $
                             uh ui_cwTouchPhoneL ui_cwTouchPhone $
+                            uh ui_cwDescriptionL ui_cwDescription
                             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 }
+          let u' = UserLight { userLight_email = fromMaybe userLight_email $ view ui_cwTouchMailL u_hyperdata'
+                             , .. }
           -- lift $ printDebug "[updateUserInfo] with firstName" u_hyperdata'
           _ <- lift $ updateHyperdata (node_u ^. node_id) u_hyperdata'
           _ <- lift $ updateUserEmail u'
@@ -149,6 +153,7 @@ updateUserInfo (UserInfoMArgs { ui_id, .. }) = do
     uh lens' (Just val) u_hyperdata = u_hyperdata & lens' .~ Just val
     uh' _ Nothing u_hyperdata = u_hyperdata
     uh' lens' (Just val) u_hyperdata = u_hyperdata & lens' .~ val
+    nId Node {_node_id} = _node_id
 
 -- | Inner function to fetch the user from DB.
 dbUsers
@@ -178,7 +183,8 @@ toUser (UserLight { .. }, u_hyperdata) =
            , ui_cwRole         = u_hyperdata ^. ui_cwRoleL
            --, ui_cwTouchMail    = u_hyperdata ^. ui_cwTouchMailL
            , ui_cwTouchMail    = Just userLight_email
-           , ui_cwTouchPhone   = u_hyperdata ^. ui_cwTouchPhoneL }
+           , ui_cwTouchPhone   = u_hyperdata ^. ui_cwTouchPhoneL
+           , ui_cwDescription  = u_hyperdata ^. ui_cwDescriptionL }
 
 sharedL :: Traversal' HyperdataUser HyperdataContact
 sharedL = hu_shared . _Just
@@ -212,3 +218,5 @@ ui_cwTouchMailL = hu_shared . _Just . (hc_where . (ix 0) . cw_touch . _Just . ct
 ui_cwTouchPhoneL :: Traversal' HyperdataUser (Maybe Text)
 ui_cwTouchPhoneL = hu_shared . _Just . (hc_where . (ix 0) . cw_touch . _Just . ct_phone)
 --ui_cwTouchPhoneL = contactWhereL . cw_touch . _Just . ct_phone
+ui_cwDescriptionL :: Traversal' HyperdataUser (Maybe Text)
+ui_cwDescriptionL = contactWhoL . cw_description