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/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)