WIP: [GQL] Basic mutation authentication

src/Gargantext/API/GraphQL/UserInfo.hs

@@ -45,6 +45,7 @@ import Gargantext.Database.Schema.User (UserLight(..))
 import Gargantext.Database.Schema.Node (node_id, node_hyperdata)
 import Gargantext.Prelude
 import GHC.Generics (Generic)
+import Gargantext.API.GraphQL.Utils (AuthStatus(Invalid, Valid), authUser)
 
 data UserInfo = UserInfo
   { ui_id             :: Int
@@ -75,6 +76,7 @@ data UserInfoArgs
 data UserInfoMArgs
   = UserInfoMArgs
     { ui_id             :: Int
+    , token             :: Text
     , ui_username       :: Maybe Text
     , ui_email          :: Maybe Text
     , ui_title          :: Maybe Text
@@ -108,35 +110,38 @@ 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."
-    ((UserLight { .. }, node_u):_) -> do
-      let u_hyperdata = node_u ^. node_hyperdata
-      -- lift $ printDebug "[updateUserInfo] u" u
-      let u_hyperdata' = uh ui_titleL ui_title $
-                         uh ui_sourceL ui_source $
-                         uh ui_cwFirstNameL ui_cwFirstName $
-                         uh ui_cwLastNameL ui_cwLastName $
-                         uh ui_cwCityL ui_cwCity $
-                         uh ui_cwCountryL ui_cwCountry $
-                         uh' ui_cwLabTeamDeptsL ui_cwLabTeamDepts $
-                         uh' ui_cwOrganizationL ui_cwOrganization $
-                         uh ui_cwOfficeL ui_cwOffice $
-                         uh ui_cwRoleL ui_cwRole $
-                         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
+    ((UserLight { .. }, node_u):_) -> 
+      case authUser ui_id token of
+        Invalid -> panic "[updateUserInfo] failed to validate user"
+        Valid -> do
+          let u_hyperdata = node_u ^. node_hyperdata
+          -- lift $ printDebug "[updateUserInfo] u" u
+          let u_hyperdata' = uh ui_titleL ui_title $
+                            uh ui_sourceL ui_source $
+                            uh ui_cwFirstNameL ui_cwFirstName $
+                            uh ui_cwLastNameL ui_cwLastName $
+                            uh ui_cwCityL ui_cwCity $
+                            uh ui_cwCountryL ui_cwCountry $
+                            uh' ui_cwLabTeamDeptsL ui_cwLabTeamDepts $
+                            uh' ui_cwOrganizationL ui_cwOrganization $
+                            uh ui_cwOfficeL ui_cwOffice $
+                            uh ui_cwRoleL ui_cwRole $
+                            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
     uh _ Nothing u_hyperdata = u_hyperdata
     uh lens' (Just val) u_hyperdata = u_hyperdata & lens' .~ Just val

src/Gargantext/API/GraphQL/Utils.hs

@@ -4,8 +4,37 @@ import Data.Morpheus.Types (GQLTypeOptions, fieldLabelModifier)
 import qualified Data.Text as T
 import Gargantext.Core.Utils.Prefix (unCapitalize, dropPrefix)
 import Gargantext.Prelude
+import Data.Text (Text)
+import Data.Text.Encoding (encodeUtf8)
+import Gargantext.API.Admin.Types (jwtSettings, HasSettings (settings))
+import Servant.Auth.Server (verifyJWT, JWTSettings)
+import Control.Lens.Getter (view)
+import Gargantext.Database.Prelude (Cmd')
+import Gargantext.API.Admin.Auth.Types (AuthenticatedUser (AuthenticatedUser, _authUser_id))
+import Data.ByteString (ByteString)
+import Gargantext.Database.Admin.Types.Node (unNodeId)
 
 unPrefix :: T.Text -> GQLTypeOptions -> GQLTypeOptions
 unPrefix prefix options = options { fieldLabelModifier = nflm }
   where
     nflm label = unCapitalize $ dropPrefix (T.unpack prefix) $ ( fieldLabelModifier options ) label
+
+data AuthStatus = Valid | Invalid
+
+authUser :: (HasSettings env) => Int -> Text -> Cmd' env err AuthStatus
+authUser ui_id token = do
+  let token' = encodeUtf8 token
+  jwtS <- view $ settings . jwtSettings
+  u <- getUserFromToken jwtS token'
+  case u of
+    Nothing -> pure Invalid
+    Just au -> 
+      if nId au == ui_id
+        then pure Valid
+        else pure Invalid
+        where
+          nId AuthenticatedUser {_authUser_id} = unNodeId _authUser_id
+
+getUserFromToken :: JWTSettings -> ByteString -> IO (Maybe AuthenticatedUser)
+getUserFromToken = verifyJWT
+