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,7 +110,10 @@ 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
+    ((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 $

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
+