Commit 8fa37c17 authored by Alexandre Delanoë's avatar Alexandre Delanoë

Merge remote-tracking branch 'origin/118-dev-gql-security' into dev-merge

parents c706aac2 7b41431a
......@@ -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 $
......
......@@ -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
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment