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

src/Gargantext/API/GraphQL/UserInfo.hs

@@ -104,14 +104,16 @@ resolveUserInfos UserInfoArgs { user_id } = dbUsers user_id
 -- | Mutation for user info
 updateUserInfo
   :: (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
   -- 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):_) -> 
-      case authUser ui_id token of
+    ((UserLight { .. }, node_u):_) -> do
+      testAuthUser <- authUser ui_id token
+      case testAuthUser of
         Invalid -> panic "[updateUserInfo] failed to validate user"
         Valid -> do
           let u_hyperdata = node_u ^. node_hyperdata

src/Gargantext/API/GraphQL/Utils.hs

+{-|
+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
 
 import Data.Morpheus.Types (GQLTypeOptions, fieldLabelModifier)
@@ -5,6 +15,7 @@ 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)
@@ -25,7 +36,7 @@ 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'
+  u <- liftBase $ getUserFromToken jwtS token'
   case u of
     Nothing -> pure Invalid
     Just au -> 

src/Gargantext/API/Prelude.hs

@@ -24,7 +24,6 @@ import Control.Concurrent (threadDelay)
 import Control.Exception (Exception)
 import Control.Lens (Prism', (#))
 import Control.Lens.TH (makePrisms)
-import Control.Monad.Error.Class (MonadError(..))
 import Control.Monad.Except (ExceptT)
 import Control.Monad.Reader (ReaderT)
 import Crypto.JOSE.Error as Jose
@@ -72,11 +71,11 @@ type ErrC err =
   )
 
 type GargServerC env err m =
-  ( CmdRandom env err m
+  ( CmdRandom    env err m
   , HasNodeStory env err m
-  , EnvC  env
-  , ErrC      err
-  , ToJSON err
+  , EnvC         env
+  , ErrC             err
+  , ToJSON           err
   )
 
 type GargServerT env err m api = GargServerC env err m => ServerT api m
@@ -102,7 +101,6 @@ type GargNoServer' env err m =
   )
 
 -------------------------------------------------------------------
-
 data GargError
   = GargNodeError    NodeError
   | GargTreeError    TreeError
@@ -133,7 +131,6 @@ instance HasServerError GargError where
 instance HasJoseError GargError where
   _JoseError = _GargJoseError
 
-
 ------------------------------------------------------------------------
 -- | Utils
 -- | Simulate logs