Merge remote-tracking branch 'origin/600-dev-wip-graphql-errors' into dev

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

@@ -76,7 +76,7 @@ addNodeViewCpt :: R.Component CreateNodeProps
 addNodeViewCpt = here.component "addNodeView" cpt where
   cpt { dispatch
       , nodeTypes } _ = do
-    let defaultNodeType = fromMaybe Folder $ head nodeTypes
+    let defaultNodeType = fromMaybe Error $ head nodeTypes
     nodeName <- T.useBox $ GT.prettyNodeType defaultNodeType
     nodeName' <- T.useLive T.unequal nodeName
     nodeType <- T.useBox defaultNodeType
@@ -85,43 +85,42 @@ addNodeViewCpt = here.component "addNodeView" cpt where
     hasChromeAgent' <- R.unsafeHooksEffect hasChromeAgent
 
     let
+        action = AddNode nodeName' nodeType'
         SettingsBox {edit} = settingsBox nodeType'
         setNodeType' nt = do
           T.write_ (GT.prettyNodeType nt) nodeName
           T.write_ nt nodeType
-        (maybeChoose /\ nt') =
+        maybeChoose =
           if length nodeTypes > 1 then
             [ Tools.formChoice { items: nodeTypes
                                , default: nodeType'
                                , callback: setNodeType'
                                , print: print hasChromeAgent' } []
-            ] /\ nodeType'
+            ]
           else
             [ H.div {}
               [H.text $ "Creating a node of type "
-               <> show defaultNt
+               <> show defaultNodeType
                <> " with name:"
               ]
-            ] /\ defaultNt
-          where
-            defaultNt = fromMaybe Error $ head nodeTypes
+            ]
         maybeEdit =
           if edit then
             [ inputWithEnterWithKey {
-                 onBlur: \val -> T.write_ val nodeName
-                 , onEnter: \_ -> launchAff_ $ dispatch (AddNode nodeName' nt')
-                 , onValueChanged: \val -> T.write_ val nodeName
-                 , autoFocus: true
+                   autoFocus: true
                  , className: "form-control"
                  , defaultValue: nodeName' -- (prettyNodeType nt')
-                 , placeholder: nodeName'  -- (prettyNodeType nt')
-                 , type: "text"
                  , key: show nodeType'
+                 , onBlur: \val -> T.write_ val nodeName
+                 , onEnter: \_ -> launchAff_ $ dispatch action
+                 , onValueChanged: \val -> T.write_ val nodeName
+                 , placeholder: nodeName'  -- (prettyNodeType nt')
                  , required: false
+                 , type: "text"
                  } ]
           else []
 
-    pure $ Tools.panelWithSubmitButton { action: AddNode nodeName' nt'
+    pure $ Tools.panelWithSubmitButton { action
                                        , dispatch
                                        , mError: Nothing } (maybeChoose <> maybeEdit)
 

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

@@ -38,7 +38,7 @@ actionAddContactCpt = here.component "actionAddContact" cpt where
     pure $
       Tools.panelNoFooter { mError: Nothing }
         [ textInputBox
-          { boxAction: \p -> AddContact p
+          { boxAction: AddContact
           , dispatch
           , id
           , params: { firstname: "", lastname: "" } }
@@ -56,7 +56,8 @@ textInputBox :: R2.Leaf TextInputBoxProps
 textInputBox = R2.leaf textInputBoxCpt
 textInputBoxCpt :: R.Component TextInputBoxProps
 textInputBoxCpt = here.component "textInputBox" cpt where
-  cpt { boxAction, dispatch
+  cpt { boxAction
+      , dispatch
       , params: { firstname, lastname } } _ = do
     
     firstName <- T.useBox firstname
@@ -102,4 +103,3 @@ textInputBoxCpt = here.component "textInputBox" cpt where
             , on: { click: \_ -> submitF unit }
             , title:"Submit"
             } []
-

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

@@ -23,17 +23,15 @@ actionDocCpt = here.component "actionDoc" cpt where
   cpt { nodeType } _ = do
     pure $
       Tools.panelNoFooter { mError: Nothing }
-        ([ infoTitle nodeType ]
+        ([ H.div { style: {margin: "10px"}}
+           [ H.h3 {} [H.text "Documentation about " ]
+           , H.h3 {className: GT.fldr nodeType true} 
+             [ H.span {className: "font-family-theme mx-1"} 
+               [ H.text $ show nodeType ] 
+             ]
+           ]
+         ]
          <> (map (\info -> H.p {} [ H.text info ]) $ docOf nodeType))
-    where
-      infoTitle :: NodeType -> R.Element
-      infoTitle nt = H.div { style: {margin: "10px"}}
-                        [ H.h3 {} [H.text "Documentation about " ]
-                        , H.h3 {className: GT.fldr nt true} 
-                          [ H.span {className: "font-family-theme mx-1"} 
-                            [ H.text $ show nt ] 
-                          ]
-                        ]
 
 -- | TODO add documentation of all NodeType
 docOf :: NodeType -> Array String

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

@@ -45,10 +45,9 @@ actionDownloadCorpusCpt = here.component "actionDownloadCorpus" cpt where
       Tools.panelWithSubmitButtonHref { action: DownloadNode
                                       , href
                                       , mError: Nothing }
-        [ H.div {} [H.text info] ]
+        [ H.div {} [H.text "Download as JSON" ] ]
     where
       href  = url session $ Routes.NodeAPI GT.Corpus (Just id) "export"
-      info  = "Download as JSON"
 
 actionDownloadGraph :: R2.Component ActionDownload
 actionDownloadGraph = R.createElement actionDownloadGraphCpt
@@ -59,10 +58,9 @@ actionDownloadGraphCpt = here.component "actionDownloadGraph" cpt where
       Tools.panelWithSubmitButtonHref { action: DownloadNode
                                       , href
                                       , mError: Nothing }
-        [ H.div {} [H.text info] ]
+        [ H.div {} [H.text "Info about the Graph as GEXF format" ] ]
     where
       href  = url session $ Routes.NodeAPI GT.Graph (Just id) "gexf"
-      info  = "Info about the Graph as GEXF format"
 
 data NodeListDownloadFormat = NL_CSV | NL_JSON
 derive instance Eq NodeListDownloadFormat

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

@@ -41,15 +41,14 @@ linkNodeCpt = here.component "linkNode" cpt
       action <- T.useBox (LinkNode { nodeType: Nothing, params: Nothing})
 
       pure $
-
           linkNode' { action
-                      , boxes
-                      , dispatch
-                      , id
-                      , nodeType
-                      , session
-                      , subTreeParams
-                      } []
+                    , boxes
+                    , dispatch
+                    , id
+                    , nodeType
+                    , session
+                    , subTreeParams
+                    } []
 
 type Props =
   ( action :: T.Box Action

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)
+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,32 +60,32 @@ 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
 teamLayoutRows = R2.leaf teamLayoutRowsCpt
 teamLayoutRowsCpt :: R.Component TeamRowProps
 teamLayoutRowsCpt = here.component "teamLayoutRows" cpt where
-  cpt { team_members, nodeId, session, error, team_owner_username } _ = do
+  cpt { error, nodeId, session, team_members, team_owner_username } _ = do
     team_members' <- T.useLive T.unequal team_members
     error' <- T.useLive T.unequal error
     
     pure $
       if null team_members' then
-        H.div { style: {margin: "10px"}}
-          [ H.h4 {} [H.text "Your team is empty, you can send some invitations."]]
+        H.div { style: {margin: "10px"} }
+          [ H.h4 {} [H.text "Your team is empty, you can send some invitations."] ]
       else
         Tools.panelNoFooter { mError: error' }
           (makeLeader team_owner_username : (map makeTeam team_members'))
@@ -104,15 +109,18 @@ teamLayoutRowsCpt = here.component "teamLayoutRows" cpt where
       submit sharedFolderId _ = do
         runAff_ callback $ saveDeleteTeam { session, nodeId, sharedFolderId }
 
-      callback res =
+      callback res = do
         case res of
-          Left _ -> do
-            _ <- liftEffect $ T.write (Just "Only the Team owner can remove users") error
-            pure unit
-          Right val ->
+          Left err -> do
+            here.log2 "[callback] error forking runAff" err
+            T.write_ (Just "Error forking 'runAff_'") error
+          Right val -> do
+            here.log2 "[callback] val" val
             case val of
-              Left _ -> do
-                pure unit
+              -- Left (EC_403__user_not_authorized { msg }) -> do
+              --   liftEffect $ T.write_ (Just msg) error
+              Left err -> do
+                T.write_ (Just $ show err) error
               Right r -> do
                 T.modify_ (filter (\tm -> tm.shared_folder_id /= r)) team_members
                 T.write_ Nothing error

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

@@ -3,13 +3,19 @@ module Gargantext.Components.GraphQL where
 import Gargantext.Prelude
 
 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)
+import Effect.Aff (Aff, throwError, error)
 import Effect.Class (liftEffect)
-import Foreign (unsafeToForeign, ForeignError)
+import FFI.Simple ((.?))
+import Foreign as Foreign
 import Gargantext.Components.GraphQL.Contact (AnnuaireContact)
 import Gargantext.Components.GraphQL.Context as GQLCTX
 import Gargantext.Components.GraphQL.IMT as GQLIMT
@@ -18,58 +24,125 @@ import Gargantext.Components.GraphQL.Node as GQLNode
 import Gargantext.Components.GraphQL.Tree (TreeFirstLevel, BreadcrumbInfo)
 import Gargantext.Components.GraphQL.User (User, UserInfo, UserInfoM, UserPubmedAPIKeyM, UserEPOAPIUserM, UserEPOAPITokenM)
 import Gargantext.Components.GraphQL.Team (Team, TeamDeleteM)
+-- import Gargantext.Config.REST (AffRESTError, FrontendError, RESTError(..))
+import Gargantext.Config.REST as REST
 import Gargantext.Ends (Backend(..))
 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 (queryWithDecoder)
-import GraphQL.Client.Types (class GqlQuery, Client, class QueryClient)
+-- import GraphQL.Client.Operation (OpMutation)
+import GraphQL.Client.Query (queryFullRes, queryWithDecoder, decodeGqlRes, getFullRes, queryFullRes) --, mutationJson)
+import GraphQL.Client.SafeQueryName (safeQueryName)
+import GraphQL.Client.ToGqlString (toGqlQueryString)
+import GraphQL.Client.Types (class GqlQuery, GqlRes, Client(..), class QueryClient, clientQuery, defQueryOpts,  clientMutation, defMutationOpts)
+import GraphQL.Client.Variables (class VarsTypeChecked, getVarsJson, getVarsTypeNames)
 import Simple.JSON as JSON
+import Type.Proxy (Proxy(..))
 import Unsafe.Coerce (unsafeCoerce)
 
 
 here :: R2.Here
 here = R2.here "Gargantext.Components.GraphQL"
 
---client :: Client AffjaxClient Schema Void Void
---client = Client $ AffjaxClient "http://localhost:8008/gql" []
 
--- | Run a graphQL query with a custom decoder and custom options
+-- TODO Rewrite this to REST.RESTError
+type E a = Either JsonDecodeError a
+
+-- | Run a graphQL query with a custom decoder
 gqlQuery ::
-  forall client schema query returns a b queryOpts mutationOpts.
-  QueryClient client queryOpts mutationOpts =>
-  GqlQuery schema query returns =>
-  JSON.ReadForeign returns =>
+  forall client schema query returns a b queryOpts mutationOpts
+   . QueryClient client queryOpts mutationOpts
+  => GqlQuery schema query returns
+  -- VarsTypeChecked query =>
+  => JSON.ReadForeign returns
   --(queryOpts -> queryOpts) ->
-  (Client client schema a b) ->
-  String ->
-  query ->
-  Aff returns
-gqlQuery = queryWithDecoder  (unsafeToForeign >>> JSON.read >>> lmap toJsonError)
+  => Client client schema a b
+  -> String
+  -> query
+  -> REST.AffRESTError returns
+gqlQuery c@(Client client) queryNameUnsafe q = do
+  let opts = defQueryOpts client
+  json <- clientQuery opts client queryName (getVarsTypeNames q <> toGqlQueryString q) (getVarsJson q)
+
+  pure $ parseGQLJson json
+  where
+    queryName = safeQueryName queryNameUnsafe
+
+-- | Run a graphQL mutation with a custom decoder
+gqlMutation ::
+  forall client schema query returns qOpts mOpts a b
+   . QueryClient client qOpts mOpts
+  => GqlQuery schema query returns
+  => VarsTypeChecked query
+  => JSON.ReadForeign returns
+  => Client client a schema b
+  -> Proxy schema
+  -> String
+  -> query
+  -> REST.AffRESTError returns
+gqlMutation c@(Client client) _ queryNameUnsafe q = do
+  let opts = defMutationOpts client
+  json <- clientMutation opts client queryName (getVarsTypeNames q <> toGqlQueryString q) (getVarsJson q)
 
-toJsonError :: NonEmptyList ForeignError -> JsonDecodeError
+  liftEffect $ here.log2 "[gqlMutation] json" json
+
+  pure $ parseGQLJson json
+  where
+    queryName = safeQueryName queryNameUnsafe
+
+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
 
 getClient :: Session -> Effect (Client UrqlClient Schema Mutation Void)
 getClient (Session { token, backend: Backend b }) = createClient { headers, url: b.baseUrl <> "/gql" }
   where
-    headers = [ ARH.RequestHeader "Authorization" $ "Bearer " <> token ]
+    headers = [ ARH.RequestHeader "Authorization" $ "Bearer " <> token
+              , ARH.RequestHeader "X-Garg-Error-Scheme" $ "new" ]
 
 queryGql ::
-  forall query returns.
-  GqlQuery Schema query returns =>
-  JSON.ReadForeign returns =>
-     Session
+  forall query returns
+   . GqlQuery Schema query returns
+  => JSON.ReadForeign returns
+  => Session
   -> String
   -> query
-  -> Aff returns
+  -> REST.AffRESTError returns
 queryGql session name q = do
-  --query client name q
   client <- liftEffect $ getClient session
   gqlQuery (client :: Client UrqlClient Schema Mutation Void) name q
 
-  --query_ "http://localhost:8008/gql" (Proxy :: Proxy Schema)
+mutationGql ::
+  forall query returns
+   . GqlQuery Mutation query returns
+  => JSON.ReadForeign returns
+  => Session
+  -> String
+  -> query
+  -> REST.AffRESTError returns
+mutationGql session name q = do
+  client <- liftEffect $ getClient session
+  gqlMutation (client :: Client UrqlClient Schema Mutation Void) (Proxy :: Proxy Mutation) name q
+  -- mutationJson (defQueryOpts client) (client :: Client UrqlClient Schema Mutation Void) name q
 
 -- Schema
 type Schema

src/Gargantext/Components/GraphQL/Endpoints.purs

@@ -3,13 +3,14 @@ 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
 import Data.Tuple (Tuple(..))
 import Effect.Aff (Aff)
 import Effect.Class (liftEffect)
-import Gargantext.Components.GraphQL (getClient, queryGql)
+import Gargantext.Components.GraphQL (E, getClient, queryGql, mutationGql)
 import Gargantext.Components.GraphQL.Contact (AnnuaireContact, annuaireContactQuery)
 import Gargantext.Components.GraphQL.Context as GQLCTX
 import Gargantext.Components.GraphQL.IMT as GQLIMT
@@ -25,7 +26,6 @@ import Gargantext.Sessions (Session(..))
 import Gargantext.Types (CorpusId, NodeType)
 import Gargantext.Utils.Reactix as R2
 import GraphQL.Client.Args (onlyArgs)
-import GraphQL.Client.Query (mutation)
 import GraphQL.Client.Variables (withVars)
 
 here :: R2.Here
@@ -33,104 +33,123 @@ 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 }
-  liftEffect $ here.log2 "[getNode] node" nodes
-  pure $ case A.head nodes of
-    Nothing -> Left (CustomError $ "node with id" <> show nodeId <>" not found")
-    Just node -> Right node
+  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")
+        Just node -> Right node
 
 getNodeCorpus :: Session -> Int -> AffRESTError Corpus
 getNodeCorpus session corpusId = do
-  { nodes_corpus } <- queryGql session "get nodes corpus" $
-                      nodesCorpusQuery `withVars` { id: corpusId }
-  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)
+  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 -> 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 }
-  liftEffect $ here.log2 "[getUser] users" users
-  pure $ case A.head users of
-    Nothing -> Left (CustomError $ "user with id " <> show id <> " not found")
-    Just u -> Right u
-
+  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")
+        Just u -> Right u
+    
 updateUserPubmedAPIKey :: Session -> Int -> String -> AffRESTError Unit
 updateUserPubmedAPIKey session user_id api_key = do
   client <- liftEffect $ getClient session
-  { update_user_pubmed_api_key } <- mutation
-                                    client
-                                    "update_user_pubmed_api_key"
-                                    { update_user_pubmed_api_key: onlyArgs { user_id
-                                                                           , api_key } }
-  pure $ Right unit
+  eRes <- mutationGql session
+                      "update_user_pubmed_api_key"
+                      { update_user_pubmed_api_key: onlyArgs { user_id
+                                                             , api_key } }
+  -- { update_user_pubmed_api_key }
+  pure $ rmap (const unit) eRes
   
 updateUserEPOAPIUser :: Session -> Int -> String -> AffRESTError Unit
 updateUserEPOAPIUser session user_id api_user = do
   client <- liftEffect $ getClient session
-  { update_user_epo_api_user } <- mutation
-                                  client
-                                  "update_user_epo_api_user"
-                                  { update_user_epo_api_user: onlyArgs { user_id
-                                                                         , api_user } }
-  pure $ Right unit
+  eRes <- mutationGql session
+                      "update_user_epo_api_user"
+                      { update_user_epo_api_user: onlyArgs { user_id
+                                                           , api_user } }
+  pure $ rmap (const unit) eRes
   
 updateUserEPOAPIToken :: Session -> Int -> String -> AffRESTError Unit
 updateUserEPOAPIToken session user_id api_token = do
   client <- liftEffect $ getClient session
-  { update_user_epo_api_token } <- mutation
-                                   client
-                                   "update_user_epo_api_token"
-                                   { update_user_epo_api_token: onlyArgs { user_id
-                                                                         , api_token } }
-  pure $ Right unit
+  eRes <- mutationGql session
+                      "update_user_epo_api_token"
+                      { update_user_epo_api_token: onlyArgs { user_id
+                                                            , api_token } }
+  pure $ rmap (const unit) eRes
 
 getUserInfo :: Session -> Int -> AffRESTError UserInfo
 getUserInfo session id = do
-  { user_infos } <- queryGql session "get user infos" $ userInfoQuery `withVars` { id }
-  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")
-    -- NOTE Contact is at G.C.N.A.U.C.Types
-    Just ui -> Right ui
-
+  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")
+        -- NOTE Contact is at G.C.N.A.U.C.Types
+        Just ui -> Right ui
+    
 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 }
-  liftEffect $ here.log2 "[getAnnuaireContact] data" annuaire_contacts
-  pure $ case A.head annuaire_contacts of
-    Nothing -> Left (CustomError $ "contact id=" <> show id <> " not found")
-    Just r  -> Right r
+  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")
+        Just r  -> Right r
 
 getTreeFirstLevel :: Session -> Int -> AffRESTError TreeFirstLevel
 getTreeFirstLevel session id = do
-  { tree } <- queryGql session "get tree first level" $ treeFirstLevelQuery `withVars` { id }
-  liftEffect $ here.log2 "[getTreeFirstLevel] tree first level" tree
-  pure $ Right tree -- TODO: error handling
-
+  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 }
-  liftEffect $ here.log2 "[getTree] data" team
-  pure $ Right team
+  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
 
 type SharedFolderId = Int
 type TeamNodeId = Int
@@ -139,68 +158,74 @@ deleteTeamMembership :: Session -> SharedFolderId -> TeamNodeId -> AffRESTError
 deleteTeamMembership session sharedFolderId teamNodeId = do
   let token = getToken session
   client <- liftEffect $ getClient session
-  { delete_team_membership } <- mutation
-    client
-    "delete_team_membership"
-    { delete_team_membership: onlyArgs { token: token
-                                       , shared_folder_id: sharedFolderId
-                                       , team_node_id: teamNodeId } }
-  pure $ case A.head delete_team_membership of
-    Nothing -> Left (CustomError $ "Failed  to delete team membership. team node id=" <> show teamNodeId <> " shared folder id=" <> show sharedFolderId)
-    Just _ -> Right sharedFolderId
+  eRes <- mutationGql session
+                      "delete_team_membership"
+                      { delete_team_membership: onlyArgs { token: token
+                                                         , shared_folder_id: sharedFolderId
+                                                         , team_node_id: teamNodeId } }
+  pure $ case eRes of
+    Left err -> Left err
+    Right { delete_team_membership } ->
+      case A.head delete_team_membership of
+        Nothing -> Left (CustomError $ "Failed  to delete team membership. team node id=" <> show teamNodeId <> " shared folder id=" <> show sharedFolderId)
+        Just _ -> Right sharedFolderId
   where
     getToken (Session { token }) = token
 
 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
-  --liftEffect $ here.log2 "[getNodeContext] node context" contexts
-  case A.head contexts of
-    Nothing -> pure $ Left $ CustomError "no node context found"
-    Just context -> pure $ Right context -- TODO: error handling
-
+  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"
+        Just context -> pure $ Right context -- TODO: error handling
+    
 type ContextsForNgramsGQL = { contexts_for_ngrams :: Array GQLCTX.Context }
 getContextsForNgrams :: Session -> CorpusId -> Array String -> AffRESTError (Array GQLCTX.Context)
 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
   client <- liftEffect $ getClient session
-  { update_node_context_category } <- mutation
-    client
-    "update_node_context_category"
-    { update_node_context_category: onlyArgs { context_id
-                                             , node_id
-                                             , category } }
-  pure $ case A.head update_node_context_category of
-    Nothing -> Left (CustomError $ "Failed to update node category")
-    Just _ -> Right context_id
+  eRes <- mutationGql session
+                      "update_node_context_category"
+                      { update_node_context_category: onlyArgs { context_id
+                                                               , node_id
+                                                               , category } }
+  pure $ case eRes of
+    Left err -> Left err
+    Right { update_node_context_category } -> case A.head update_node_context_category of
+      Nothing -> Left (CustomError $ "Failed to update node category")
+      Just _ -> Right context_id
 
 getLanguages :: Session -> AffRESTError (Map.Map Lang GQLNLP.LanguageProperties)
 getLanguages session = do
   let query = GQLNLP.nlpQuery
-  { languages } <- queryGql session "get languages" query
-
-  liftEffect $ here.log2 "[getLanguages] languages" languages
-
-  pure $ Right $ Map.fromFoldable $ (\{ key, value } -> Tuple key value) <$> languages
+  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
 
 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 }
@@ -69,6 +72,8 @@ data FrontendError =
   | EC_403__login_failed_error { node_id :: Int
                                , user_id :: Int }
   | EC_403__login_failed_invalid_username_or_password
+  | EC_403__user_not_authorized { user_id :: Int
+                                , msg     :: String }
   | EC_404__node_context_not_found { context_id :: Int }
   | EC_404__node_lookup_failed_not_found { node_id :: Int }
   | EC_404__node_lookup_failed_parent_not_found { node_id :: Int }
@@ -94,6 +99,8 @@ instance Show FrontendError where
     "Login failed for node_id " <> show node_id <> ", user id " <> show user_id
   show EC_403__login_failed_invalid_username_or_password =
     "Invalid username or password"
+  show (EC_403__user_not_authorized { user_id, msg }) =
+    "User not authorized to perform action: " <> show user_id <> ". " <> msg
   show (EC_404__node_context_not_found { context_id }) =
     "Context not found with id " <> show context_id
   show (EC_404__node_lookup_failed_not_found { node_id }) =
@@ -138,6 +145,10 @@ instance JSON.ReadForeign FrontendError where
         pure $ EC_403__login_failed_error { node_id, user_id }
       "EC_403__login_failed_invalid_username_or_password" -> do
         pure $ EC_403__login_failed_invalid_username_or_password
+      "EC_403__user_not_authorized" -> do
+        { data: { user_id, msg } } <- JSON.readImpl f :: Foreign.F { data :: { user_id :: Int
+                                                                             , msg :: String } }
+        pure $ EC_403__user_not_authorized { user_id, msg }
       "EC_404__node_context_not_found" -> do
         { data: { context_id } } <- JSON.readImpl f :: Foreign.F { data :: { context_id :: Int } }
         pure $ EC_404__node_context_not_found { context_id }
@@ -168,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)