Commit 6c049d5e authored by Alexandre Delanoë's avatar Alexandre Delanoë

[WIP] The business Monad should be clearer for the GaphQL modules

parent 8fa37c17
...@@ -104,14 +104,16 @@ resolveUserInfos UserInfoArgs { user_id } = dbUsers user_id ...@@ -104,14 +104,16 @@ resolveUserInfos UserInfoArgs { user_id } = dbUsers user_id
-- | Mutation for user info -- | Mutation for user info
updateUserInfo updateUserInfo
:: (HasConnectionPool env, HasConfig env, HasMail env) :: (HasConnectionPool env, HasConfig env, HasMail env)
=> UserInfoMArgs -> ResolverM e (GargM env GargError) Int -- => UserInfoMArgs -> ResolverM e (GargM env err) Int
=> UserInfoMArgs -> GqlM e env Int
updateUserInfo (UserInfoMArgs { ui_id, .. }) = do updateUserInfo (UserInfoMArgs { ui_id, .. }) = do
-- lift $ printDebug "[updateUserInfo] ui_id" ui_id -- lift $ printDebug "[updateUserInfo] ui_id" ui_id
users <- lift (getUsersWithNodeHyperdata ui_id) users <- lift (getUsersWithNodeHyperdata ui_id)
case users of case users of
[] -> panic $ "[updateUserInfo] User with id " <> (T.pack $ show ui_id) <> " doesn't exist." [] -> panic $ "[updateUserInfo] User with id " <> (T.pack $ show ui_id) <> " doesn't exist."
((UserLight { .. }, node_u):_) -> ((UserLight { .. }, node_u):_) -> do
case authUser ui_id token of testAuthUser <- authUser ui_id token
case testAuthUser of
Invalid -> panic "[updateUserInfo] failed to validate user" Invalid -> panic "[updateUserInfo] failed to validate user"
Valid -> do Valid -> do
let u_hyperdata = node_u ^. node_hyperdata let u_hyperdata = node_u ^. node_hyperdata
......
{-|
Module : Gargantext.API.GraphQL.Utils
Description : Utils for GraphQL API
Copyright : (c) CNRS, 2017-Present
License : AGPL + CECILL v3
Maintainer : team@gargantext.org
Stability : experimental
Portability : POSIX
-}
module Gargantext.API.GraphQL.Utils where module Gargantext.API.GraphQL.Utils where
import Data.Morpheus.Types (GQLTypeOptions, fieldLabelModifier) import Data.Morpheus.Types (GQLTypeOptions, fieldLabelModifier)
...@@ -5,6 +15,7 @@ import qualified Data.Text as T ...@@ -5,6 +15,7 @@ import qualified Data.Text as T
import Gargantext.Core.Utils.Prefix (unCapitalize, dropPrefix) import Gargantext.Core.Utils.Prefix (unCapitalize, dropPrefix)
import Gargantext.Prelude import Gargantext.Prelude
import Data.Text (Text) import Data.Text (Text)
import Control.Monad.Error.Class (MonadError(..))
import Data.Text.Encoding (encodeUtf8) import Data.Text.Encoding (encodeUtf8)
import Gargantext.API.Admin.Types (jwtSettings, HasSettings (settings)) import Gargantext.API.Admin.Types (jwtSettings, HasSettings (settings))
import Servant.Auth.Server (verifyJWT, JWTSettings) import Servant.Auth.Server (verifyJWT, JWTSettings)
...@@ -25,7 +36,7 @@ authUser :: (HasSettings env) => Int -> Text -> Cmd' env err AuthStatus ...@@ -25,7 +36,7 @@ authUser :: (HasSettings env) => Int -> Text -> Cmd' env err AuthStatus
authUser ui_id token = do authUser ui_id token = do
let token' = encodeUtf8 token let token' = encodeUtf8 token
jwtS <- view $ settings . jwtSettings jwtS <- view $ settings . jwtSettings
u <- getUserFromToken jwtS token' u <- liftBase $ getUserFromToken jwtS token'
case u of case u of
Nothing -> pure Invalid Nothing -> pure Invalid
Just au -> Just au ->
......
...@@ -24,7 +24,6 @@ import Control.Concurrent (threadDelay) ...@@ -24,7 +24,6 @@ import Control.Concurrent (threadDelay)
import Control.Exception (Exception) import Control.Exception (Exception)
import Control.Lens (Prism', (#)) import Control.Lens (Prism', (#))
import Control.Lens.TH (makePrisms) import Control.Lens.TH (makePrisms)
import Control.Monad.Error.Class (MonadError(..))
import Control.Monad.Except (ExceptT) import Control.Monad.Except (ExceptT)
import Control.Monad.Reader (ReaderT) import Control.Monad.Reader (ReaderT)
import Crypto.JOSE.Error as Jose import Crypto.JOSE.Error as Jose
...@@ -102,7 +101,6 @@ type GargNoServer' env err m = ...@@ -102,7 +101,6 @@ type GargNoServer' env err m =
) )
------------------------------------------------------------------- -------------------------------------------------------------------
data GargError data GargError
= GargNodeError NodeError = GargNodeError NodeError
| GargTreeError TreeError | GargTreeError TreeError
...@@ -133,7 +131,6 @@ instance HasServerError GargError where ...@@ -133,7 +131,6 @@ instance HasServerError GargError where
instance HasJoseError GargError where instance HasJoseError GargError where
_JoseError = _GargJoseError _JoseError = _GargJoseError
------------------------------------------------------------------------ ------------------------------------------------------------------------
-- | Utils -- | Utils
-- | Simulate logs -- | Simulate logs
......
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