[graphql] mutation with support for errors

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

@@ -78,14 +78,14 @@ 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'))
@@ -109,16 +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 (EC_403__user_not_authorized { msg }) -> do
-          --   liftEffect $ T.write_ (Just msg) error
           Left err -> do
-            liftEffect $ T.write_ (Just $ show err) error
-          Right val ->
+            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/GraphQL.purs

@@ -31,12 +31,14 @@ 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, getFullRes, queryFullRes)
+-- 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)
+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)
 
 
@@ -47,30 +49,48 @@ here = R2.here "Gargantext.Components.GraphQL"
 -- TODO Rewrite this to REST.RESTError
 type E a = Either JsonDecodeError a
 
---client :: Client AffjaxClient Schema Void Void
---client = Client $ AffjaxClient "http://localhost:8008/gql" []
-
--- | Run a graphQL query with a custom decoder and custom options
+-- | 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 =>
+  forall client schema query returns a b queryOpts mutationOpts
+   . QueryClient client queryOpts mutationOpts
+  => GqlQuery schema query returns
   -- VarsTypeChecked query =>
-  JSON.ReadForeign returns =>
+  => JSON.ReadForeign returns
   --(queryOpts -> queryOpts) ->
-  (Client client schema a b) ->
-  String ->
-  query ->
-  REST.AffRESTError returns
+  => 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)
+
+  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
@@ -100,19 +120,29 @@ getClient (Session { token, backend: Backend b }) = createClient { headers, url:
               , 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
   -> 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

@@ -10,7 +10,7 @@ import Data.Map as Map
 import Data.Tuple (Tuple(..))
 import Effect.Aff (Aff)
 import Effect.Class (liftEffect)
-import Gargantext.Components.GraphQL (E, 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
@@ -26,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
@@ -85,32 +84,30 @@ getUser session id = do
 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
@@ -161,15 +158,17 @@ 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
 
@@ -196,15 +195,16 @@ getContextsForNgrams session corpus_id ngrams_terms = do
 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