[graphql] implement new type errors

src/Gargantext/Components/Forest/Tree/Node/Action/ManageTeam.purs

@@ -2,18 +2,19 @@ module Gargantext.Components.Forest.Tree.Node.Action.ManageTeam where
 
 import Gargantext.Prelude
 
-import Data.Array (filter, null, (:))
+import Data.Array (cons, filter, null, (:))
 import Data.Either (Either(..))
 import Data.Maybe (Maybe(..))
 import Effect.Aff (runAff_)
 import Effect.Class (liftEffect)
+import Gargantext.Components.App.Store (Boxes)
 import Gargantext.Components.Forest.Tree.Node.Tools as Tools
 import Gargantext.Components.GraphQL.Endpoints (deleteTeamMembership, getTeam)
 import Gargantext.Components.GraphQL.Team (Team, TeamMember)
 import Gargantext.Config.REST (AffRESTError, logRESTError, FrontendError(EC_403__user_not_authorized))
 import Gargantext.Hooks.Loader (useLoader)
 import Gargantext.Sessions (Session)
-import Gargantext.Types (ID, NodeType)
+import Gargantext.Types (ID, FrontendError(FRESTError), NodeType)
 import Gargantext.Utils.Reactix as R2
 import Reactix as R
 import Reactix.DOM.HTML as H
@@ -23,18 +24,18 @@ here :: R2.Here
 here = R2.here "Gargantext.Components.Forest.Tree.Node.Action.ManageTeam"
 
 type ActionManageTeam = (
-  id       :: ID
-, nodeType :: NodeType
-, session  :: Session
+    boxes    :: Boxes
+  , id       :: ID
+  , nodeType :: NodeType
+  , session  :: Session
 )
 
 actionManageTeam :: R2.Component ActionManageTeam
 actionManageTeam = R.createElement actionManageTeamCpt
-
 actionManageTeamCpt :: R.Component ActionManageTeam
 actionManageTeamCpt = here.component "actionManageTeam" cpt where
-  cpt {id, session} _ = do
-    useLoader { errorHandler
+  cpt { boxes: { errors }, id, session } _ = do
+    useLoader { errorHandler: errorHandler errors
               , loader: loadTeam
               , path: { nodeId: id, session }
               , render: \team -> teamLayoutWrapper { team
@@ -43,7 +44,11 @@ actionManageTeamCpt = here.component "actionManageTeam" cpt where
                                                    } []
               }
     where
-      errorHandler = logRESTError here "teamLayout"
+      errorHandler errors error = do
+        logRESTError here "teamLayout" error
+        T.modify_ (cons $ FRESTError { error }) errors
+        
+        -- T.write_ (Just $ show error) errorS
 
 type TeamProps =
   ( nodeId  :: ID
@@ -55,17 +60,17 @@ teamLayoutWrapper :: R2.Component TeamProps
 teamLayoutWrapper = R.createElement teamLayoutWrapperCpt
 teamLayoutWrapperCpt :: R.Component TeamProps
 teamLayoutWrapperCpt = here.component "teamLayoutWrapper" cpt where
-  cpt {nodeId, session, team: {team_owner_username, team_members}} _ = do
-    team_members <- T.useBox team_members
+  cpt { nodeId, session, team: { team_owner_username, team_members } } _ = do
     error <- T.useBox Nothing    
+    team_members <- T.useBox team_members
 
     pure $ teamLayoutRows {nodeId, session, team_members, error, team_owner_username}
 
 type TeamRowProps =
-  ( nodeId               :: ID
+  ( error   :: T.Box (Maybe String)
+  , nodeId               :: ID
   , session              :: Session
   , team_members         :: T.Box (Array TeamMember)
-  , error                :: T.Box (Maybe String)
   , team_owner_username  :: String
   )
 

src/Gargantext/Components/Forest/Tree/Node/Box.purs

@@ -346,8 +346,8 @@ panelActionCpt = here.component "panelAction" cpt
       pure $ actionDownload { id, nodeType, session } []
     cpt { action: Link {subTreeParams}, boxes, dispatch, id, nodeType, session } _ =
       pure $ linkNode { boxes, dispatch, id, nodeType, session, subTreeParams } []
-    cpt { action: ManageTeam, nodeType, id, session} _ =
-      pure $ actionManageTeam { id, nodeType, session } []
+    cpt { action: ManageTeam, boxes, nodeType, id, session} _ =
+      pure $ actionManageTeam { boxes, id, nodeType, session } []
     cpt { action: Merge {subTreeParams}, boxes, dispatch, id, nodeType, session } _ =
       pure $ mergeNode { boxes, dispatch, id, nodeType, session, subTreeParams } []
     cpt { action: Move {subTreeParams}, boxes, dispatch, id, nodeType, session } _ =

src/Gargantext/Components/GraphQL.purs

@@ -6,12 +6,15 @@ import Affjax.RequestHeader as ARH
 import Control.Monad.Error.Class as Errors
 import Data.Argonaut.Core as AC
 import Data.Argonaut.Decode (JsonDecodeError)
+import Data.Array as A
 import Data.Bifunctor (lmap)
 import Data.Either (Either(..))
 import Data.List.Types (NonEmptyList)
+import Data.Maybe (Maybe(..))
 import Effect (Effect)
 import Effect.Aff (Aff, throwError, error)
 import Effect.Class (liftEffect)
+import FFI.Simple ((.?))
 import Foreign as Foreign
 import Gargantext.Components.GraphQL.Contact (AnnuaireContact)
 import Gargantext.Components.GraphQL.Context as GQLCTX
@@ -28,7 +31,7 @@ import Gargantext.Sessions (Session(..))
 import Gargantext.Utils.Reactix as R2
 import GraphQL.Client.Args (type (==>))
 import GraphQL.Client.BaseClients.Urql (UrqlClient, createClient)
-import GraphQL.Client.Query (queryFullRes, queryWithDecoder, decodeGqlRes, queryFullRes)
+import GraphQL.Client.Query (queryFullRes, queryWithDecoder, decodeGqlRes, getFullRes, queryFullRes)
 import GraphQL.Client.SafeQueryName (safeQueryName)
 import GraphQL.Client.ToGqlString (toGqlQueryString)
 import GraphQL.Client.Types (class GqlQuery, GqlRes, Client(..), class QueryClient, clientQuery, defQueryOpts)
@@ -58,56 +61,34 @@ gqlQuery ::
   (Client client schema a b) ->
   String ->
   query ->
-  Aff returns
-  -- REST.AffRESTError returns
--- TODO Send this by hand, parse errors if any
---   GQL API returns status != 200 for errors.
--- gqlQuery = queryWithDecoder  (Foreign.unsafeToForeign >>> JSON.read >>> lmap toJsonError)
+  REST.AffRESTError returns
 gqlQuery c@(Client client) queryNameUnsafe q = do
-  -- res@{ data_ } <-
-  --   queryFullRes (Foreign.unsafeToForeign >>> JSON.read >>> lmap toJsonError) (const $ defQueryOpts client) c queryNameUnsafe q :: Aff (GqlRes returns)
-  -- liftEffect $ here.log2 "[gqlQuery] res" res
-  -- case data_ of
-  --   Left err -> do
-  --     liftEffect $ here.log2 "[gqlQuery] err" err
-  --     throwError $ error "Error!"
-  --   Right res -> pure res
-
   let opts = defQueryOpts client
-      decodeFn = Foreign.unsafeToForeign >>> JSON.read >>> lmap toJsonError
-      handleError err = do
-        liftEffect $ here.log2 "[gqlQuery] error" err
-        pure $ AC.fromString ""
-  liftEffect $ here.log2 "[gqlQuery] calling query" q
-  json <- Errors.catchError (clientQuery opts client queryName (getVarsTypeNames q <> toGqlQueryString q) (getVarsJson q)) handleError
-  -- json <- clientQuery opts client queryName (getVarsTypeNames q <> toGqlQueryString q) (getVarsJson q)
-  -- NOTE 'json' contains interesting data, in particular the gql operation, error, etc
-  liftEffect $ here.log2 "[gqlQuery] json" json
-  -- pure $ REST.readJSON json
-  -- pure $ decodeJSONOrError $ Foreign.unsafeToForeign json
-  -- pure $ lmap foreignToRESTError $ JSON.read $ Foreign.unsafeToForeign json
 
-  -- case (JSON.read $ Foreign.unsafeToForeign json) of
-  --   Right a -> pure a
-  --   Left err -> throwError $ error $ show err
+  json <- clientQuery opts client queryName (getVarsTypeNames q <> toGqlQueryString q) (getVarsJson q)
 
-  -- what 'decodeGqlRes' does is take 'json.data' and decode it using our custom decode function
-  case (decodeGqlRes decodeFn json) of
-    Left err -> throwError $ error $ show err
-    Right a -> pure a
+  pure $ parseGQLJson json
   where
     queryName = safeQueryName queryNameUnsafe
 
-
--- decodeJSONOrError :: forall a. JSON.ReadForeign a => Foreign.Foreign -> Either RESTError a
--- decodeJSONOrError f =
---   lmap parseJSONError (JSON.read f :: JSON.E a)
---   where
---     parseJSONError :: Foreign.Foreign -> RESTError
---     parseJSONError f =
---       case (JSON.read f :: JSON.E FrontendError) of
---         Right err -> FE err
---         Left
+parseGQLJson json =
+  -- NOTE 'json' contains interesting data, in particular the gql operation, error, etc
+  case json .? "error" of
+    -- what 'decodeGqlRes' does is take 'json.data' and decode it using our custom decode function
+    Nothing -> lmap (REST.ReadJSONError <<< unsafeCoerce) (decodeGqlRes decodeFn json)
+    Just err ->
+      -- Surely, an error must be returned, but which one?
+      Left $ case err .? "graphQLErrors" of
+        Nothing -> REST.CustomError "[gqlQuery] no 'graphQLErrors'"
+        Just gqlErrors -> case A.head gqlErrors of
+          Nothing -> REST.CustomError "[gqlQuery] empty 'graphQLErrors'"
+          Just gqlErr -> case gqlErr .? "extensions" of
+            Nothing -> REST.CustomError "[gqlQuery] graphQLError no 'extensions'"
+            Just ext -> case (Foreign.unsafeToForeign >>> JSON.read >>> lmap toJsonError $ ext) of
+              Left err'  -> REST.CustomError $ "[gqlQuery] error reading 'extensions': " <> show err'
+              Right err' -> REST.FE err'
+  where
+    decodeFn = Foreign.unsafeToForeign >>> JSON.read >>> lmap toJsonError
 
 toJsonError :: Foreign.MultipleErrors -> JsonDecodeError
 toJsonError = unsafeCoerce  -- map ForeignErrors to JsonDecodeError as you wish
@@ -125,7 +106,7 @@ queryGql ::
      Session
   -> String
   -> query
-  -> Aff returns
+  -> REST.AffRESTError returns
 queryGql session name q = do
   --query client name q
   client <- liftEffect $ getClient session

src/Gargantext/Components/GraphQL/Endpoints.purs

@@ -3,6 +3,7 @@ module Gargantext.Components.GraphQL.Endpoints where
 import Gargantext.Prelude
 
 import Data.Array as A
+import Data.Bifunctor (rmap)
 import Data.Either (Either(..))
 import Data.Maybe (Maybe(..))
 import Data.Map as Map
@@ -33,15 +34,17 @@ here = R2.here "Gargantext.Components.GraphQL.Endpoints"
 
 getIMTSchools :: Session -> AffRESTError (Array GQLIMT.School)
 getIMTSchools session = do
-  { imt_schools } <- queryGql session "get imt schools" $
-                         GQLIMT.schoolsQuery
-  liftEffect $ here.log2 "[getIMTSchools] imt_schools" imt_schools
-  pure $ Right imt_schools
+  eRes <- queryGql session "get imt schools" $ GQLIMT.schoolsQuery
+  pure $ rmap _.imt_schools eRes
+  -- liftEffect $ here.log2 "[getIMTSchools] imt_schools" imt_schools
+  -- pure $ Right imt_schools
 
 getNode :: Session -> Int -> AffRESTError Node
 getNode session nodeId = do
-  { nodes } <- queryGql session "get nodes" $
-              nodesQuery `withVars` { id: nodeId }
+  eRes <- queryGql session "get nodes" $ nodesQuery `withVars` { id: nodeId }
+  case eRes of
+    Left err -> pure $ Left err
+    Right { nodes } -> do
       liftEffect $ here.log2 "[getNode] node" nodes
       pure $ case A.head nodes of
         Nothing -> Left (CustomError $ "node with id" <> show nodeId <>" not found")
@@ -49,24 +52,31 @@ getNode session nodeId = do
 
 getNodeCorpus :: Session -> Int -> AffRESTError Corpus
 getNodeCorpus session corpusId = do
-  { nodes_corpus } <- queryGql session "get nodes corpus" $
+  eRes <- queryGql session "get nodes corpus" $
               nodesCorpusQuery `withVars` { id: corpusId }                      
+  case eRes of
+    Left err -> pure $ Left err
+    Right { nodes_corpus } -> do
       liftEffect $ here.log2 "[getNodesCorpus] nodes_corpus" nodes_corpus
       pure $ case A.head nodes_corpus of
         Nothing -> Left (CustomError $ "corpus with id" <> show corpusId <>" not found")
         Just corpus -> Right corpus
 
-getNodeParent :: Session -> Int -> NodeType -> Aff (Array Node)
+getNodeParent :: Session -> Int -> NodeType -> AffRESTError (Array Node)
 getNodeParent session nodeId parentType = do
-  { node_parent } <- queryGql session "get node parent" $
+  eRes <- queryGql session "get node parent" $
                      nodeParentQuery `withVars` { id: nodeId
                                                 , parent_type: show parentType }  -- TODO: remove "show"
-  liftEffect $ here.log2 "[getNodeParent] node_parent" node_parent
-  pure node_parent
+  -- liftEffect $ here.log2 "[getNodeParent] node_parent" node_parent
+  --pure node_parent
+  pure $ rmap _.node_parent eRes
 
 getUser :: Session -> Int -> AffRESTError User
 getUser session id = do
-  { users } <- queryGql session "get user" $ userQuery `withVars` { id }
+  eRes <- queryGql session "get user" $ userQuery `withVars` { id }
+  case eRes of
+    Left err -> pure $ Left err
+    Right { users } -> do
       liftEffect $ here.log2 "[getUser] users" users
       pure $ case A.head users of
         Nothing -> Left (CustomError $ "user with id " <> show id <> " not found")
@@ -104,7 +114,10 @@ updateUserEPOAPIToken session user_id api_token = do
 
 getUserInfo :: Session -> Int -> AffRESTError UserInfo
 getUserInfo session id = do
-  { user_infos } <- queryGql session "get user infos" $ userInfoQuery `withVars` { id }
+  eRes <- queryGql session "get user infos" $ userInfoQuery `withVars` { id }
+  case eRes of
+    Left err -> pure $ Left err
+    Right { user_infos } -> do
       liftEffect $ here.log2 "[getUserInfo] user infos" user_infos
       pure $ case A.head user_infos of
         Nothing -> Left (CustomError $ "user with id " <> show id <> " not found")
@@ -113,8 +126,11 @@ getUserInfo session id = do
     
 getAnnuaireContact :: Session -> Int -> AffRESTError AnnuaireContact
 getAnnuaireContact session id = do
-  { annuaire_contacts } <- queryGql session "get annuaire contact" $
+  eRes <- queryGql session "get annuaire contact" $
     annuaireContactQuery `withVars` { id }
+  case eRes of
+    Left err -> pure $ Left err
+    Right { annuaire_contacts } -> do
       liftEffect $ here.log2 "[getAnnuaireContact] data" annuaire_contacts
       pure $ case A.head annuaire_contacts of
         Nothing -> Left (CustomError $ "contact id=" <> show id <> " not found")
@@ -122,13 +138,19 @@ getAnnuaireContact session id = do
 
 getTreeFirstLevel :: Session -> Int -> AffRESTError TreeFirstLevel
 getTreeFirstLevel session id = do
-  { tree } <- queryGql session "get tree first level" $ treeFirstLevelQuery `withVars` { id }
+  eRes <- queryGql session "get tree first level" $ treeFirstLevelQuery `withVars` { id }
+  case eRes of
+    Left err -> pure $ Left err
+    Right { tree } -> do
       liftEffect $ here.log2 "[getTreeFirstLevel] tree first level" tree
       pure $ Right tree -- TODO: error handling
     
 getTeam :: Session -> Int -> AffRESTError Team
 getTeam session id = do
-  { team } <- queryGql session "get team" $ teamQuery `withVars` { id }
+  eRes <- queryGql session "get team" $ teamQuery `withVars` { id }
+  case eRes of
+    Left err -> pure $ Left err
+    Right { team } -> do
       liftEffect $ here.log2 "[getTree] data" team
       pure $ Right team
 
@@ -154,7 +176,10 @@ deleteTeamMembership session sharedFolderId teamNodeId = do
 getNodeContext :: Session -> Int -> Int -> AffRESTError GQLCTX.NodeContext
 getNodeContext session context_id node_id = do
   let query = GQLCTX.nodeContextQuery `withVars` { context_id, node_id }
-  { contexts } <- queryGql session "get node context" query
+  eRes <- queryGql session "get node context" query
+  case eRes of
+    Left err -> pure $ Left err
+    Right { contexts } -> do
       --liftEffect $ here.log2 "[getNodeContext] node context" contexts
       case A.head contexts of
         Nothing -> pure $ Left $ CustomError "no node context found"
@@ -165,10 +190,8 @@ getContextsForNgrams :: Session -> CorpusId -> Array String -> AffRESTError (Arr
 getContextsForNgrams session corpus_id ngrams_terms = do
   let query = GQLCTX.contextsForNgramsQuery `withVars` { corpus_id
                                                        , ngrams_terms: GQLCTX.NgramsTerms ngrams_terms }
-  { contexts_for_ngrams } <- queryGql session "get contexts for ngrams" query
-
-  pure $ Right contexts_for_ngrams
-  --pure $ Right contexts_for_ngrams
+  eRes <- queryGql session "get contexts for ngrams" query
+  pure $ rmap _.contexts_for_ngrams eRes
 
 updateNodeContextCategory :: Session -> Int -> Int -> Int -> AffRESTError Int
 updateNodeContextCategory session context_id node_id category = do
@@ -186,8 +209,10 @@ updateNodeContextCategory session context_id node_id category = do
 getLanguages :: Session -> AffRESTError (Map.Map Lang GQLNLP.LanguageProperties)
 getLanguages session = do
   let query = GQLNLP.nlpQuery
-  { languages } <- queryGql session "get languages" query
-
+  eRes <- queryGql session "get languages" query
+  case eRes of
+    Left err -> pure $ Left err
+    Right { languages } -> do    
       liftEffect $ here.log2 "[getLanguages] languages" languages
     
       pure $ Right $ Map.fromFoldable $ (\{ key, value } -> Tuple key value) <$> languages
@@ -196,11 +221,11 @@ getContextNgrams :: Session -> Int -> Int -> AffRESTError (Array NgramsTerm)
 getContextNgrams session context_id list_id = do
   client <- liftEffect $ getClient session
   let query = GQLCTX.contextNgramsQuery `withVars` { context_id, list_id }
-  { context_ngrams } <- queryGql session "get context ngrams" query
-  pure $ Right $ NormNgramsTerm <$> context_ngrams
+  eRes <- queryGql session "get context ngrams" query
+  pure $ rmap (\{ context_ngrams } -> NormNgramsTerm <$> context_ngrams) eRes
 
 getBreadcrumb :: Session -> Int -> AffRESTError BreadcrumbInfo
 getBreadcrumb session id = do
-  { tree_branch } <- queryGql session "get breadcrumb branch" $ breadcrumbQuery `withVars` { id }
-  liftEffect $ here.log2 "[getBreadcrumb] breadcrumb" tree_branch
-  pure $ Right tree_branch
+  eRes <- queryGql session "get breadcrumb branch" $ breadcrumbQuery `withVars` { id }
+  -- liftEffect $ here.log2 "[getBreadcrumb] breadcrumb" tree_branch
+  pure $ rmap _.tree_branch eRes

src/Gargantext/Config/REST.purs

@@ -56,6 +56,9 @@ instance Eq RESTError where
   eq _ _ = false
 
 
+type AffRESTError a = Aff (Either RESTError a)
+
+
 data FrontendError =
     EC_400__node_creation_failed_insert_node { user_id :: Int
                                              , parent_id :: Int }
@@ -176,8 +179,6 @@ logRESTError here' prefix e = here'.warn2 (prefix <> " " <> show e) e
 -- logRESTError here prefix (ReadJSONError e) = here.warn2 (prefix <> " ReadJSONError ") $ show e
 -- logRESTError here prefix (CustomError e) = here.warn2 (prefix <> " CustomError ") $ e
 
-type AffRESTError a = Aff (Either RESTError a)
-
 
 readJSON :: forall a. JSON.ReadForeign a
          => Either Affjax.Error (Affjax.Response AC.Json)