[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,18 +60,18 @@ 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
+  cpt { nodeId, session, team: { team_owner_username, team_members } } _ = do
+    error <- T.useBox Nothing    
     team_members <- T.useBox team_members
-    error <- T.useBox Nothing
 
     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
+  , team_owner_username  :: String
   )
 
 teamLayoutRows :: R2.Leaf TeamRowProps

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
-
-  -- 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
+
+  json <- clientQuery opts client queryName (getVarsTypeNames q <> toGqlQueryString q) (getVarsJson q)
+
+  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/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)