Commit 75afdbb5 authored by Karen Konou's avatar Karen Konou

[GQL] Match updated user with user from token

parent 5a8f7ecd
Pipeline #2687 failed with stage
in 63 minutes and 50 seconds
......@@ -59,6 +59,7 @@ import Servant
)
import qualified Servant.Auth as SA
import qualified Servant.Auth.Server as SAS
import Gargantext.API.Admin.Types (HasSettings)
-- | Represents possible GraphQL queries.
data Query m
......@@ -95,7 +96,7 @@ data Contet m
-- | The main GraphQL resolver: how queries, mutations and
-- subscriptions are handled.
rootResolver
:: (HasConnectionPool env, HasConfig env, HasMail env, HasJobEnv' env)
:: (HasConnectionPool env, HasConfig env, HasMail env, HasJobEnv' env, HasSettings env)
=> RootResolver (GargM env GargError) e Query Mutation Undefined
rootResolver =
RootResolver
......@@ -111,7 +112,7 @@ rootResolver =
-- | Main GraphQL "app".
app
:: (Typeable env, HasConnectionPool env, HasConfig env, HasMail env, HasJobEnv' env)
:: (Typeable env, HasConnectionPool env, HasConfig env, HasMail env, HasJobEnv' env, HasSettings env)
=> App (EVENT (GargM env GargError)) (GargM env GargError)
app = deriveApp rootResolver
......@@ -155,7 +156,7 @@ gqapi = Proxy
-- | Implementation of our API.
--api :: Server API
api
:: (Typeable env, HasConnectionPool env, HasConfig env, HasMail env, HasJobEnv' env)
:: (Typeable env, HasConnectionPool env, HasConfig env, HasMail env, HasJobEnv' env, HasSettings env)
=> ServerT API (GargM env GargError)
api (SAS.Authenticated _auser) = httpPubApp [] app :<|> pure httpPlayground
api _ = SAS.throwAll (_ServerError # err401)
api _ = panic "401 in graphql" -- SAS.throwAll (_ServerError # err401)
......@@ -42,10 +42,12 @@ 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)
import Gargantext.Database.Admin.Types.Node (unNodeId)
data UserInfo = UserInfo
{ ui_id :: Int
......@@ -94,6 +96,7 @@ data UserInfoMArgs
} 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 +106,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
......@@ -149,6 +152,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} = unNodeId _node_id
-- | Inner function to fetch the user from DB.
dbUsers
......
......@@ -15,7 +15,6 @@ import qualified Data.Text as T
import Gargantext.Core.Utils.Prefix (unCapitalize, dropPrefix)
import Gargantext.Prelude
import Data.Text (Text)
import Control.Monad.Error.Class (MonadError(..))
import Data.Text.Encoding (encodeUtf8)
import Gargantext.API.Admin.Types (jwtSettings, HasSettings (settings))
import Servant.Auth.Server (verifyJWT, JWTSettings)
......@@ -48,4 +47,3 @@ authUser ui_id token = do
getUserFromToken :: JWTSettings -> ByteString -> IO (Maybe AuthenticatedUser)
getUserFromToken = verifyJWT
......@@ -26,6 +26,7 @@ import Control.Lens (Prism', (#))
import Control.Lens.TH (makePrisms)
import Control.Monad.Except (ExceptT)
import Control.Monad.Reader (ReaderT)
import Control.Monad.Error.Class (MonadError(..))
import Crypto.JOSE.Error as Jose
import Data.Aeson.Types
import Data.Typeable
......
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