[graphql] WIP new backend error format

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

@@ -10,7 +10,7 @@ import Effect.Class (liftEffect)
 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)
@@ -106,9 +106,10 @@ teamLayoutRowsCpt = here.component "teamLayoutRows" cpt where
 
       callback res =
         case res of
-          Left _ -> do
-            _ <- liftEffect $ T.write (Just "Only the Team owner can remove users") error
-            pure unit
+          -- 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 ->
             case val of
               Left _ -> do

src/Gargantext/Components/GraphQL.purs

@@ -3,13 +3,16 @@ 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.Bifunctor (lmap)
+import Data.Either (Either(..))
 import Data.List.Types (NonEmptyList)
 import Effect (Effect)
-import Effect.Aff (Aff)
+import Effect.Aff (Aff, throwError, error)
 import Effect.Class (liftEffect)
-import Foreign (unsafeToForeign, ForeignError)
+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,13 +21,18 @@ 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.Query (queryFullRes, queryWithDecoder, decodeGqlRes, queryFullRes)
+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.Variables (class VarsTypeChecked, getVarsJson, getVarsTypeNames)
 import Simple.JSON as JSON
 import Unsafe.Coerce (unsafeCoerce)
 
@@ -32,6 +40,10 @@ import Unsafe.Coerce (unsafeCoerce)
 here :: R2.Here
 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" []
 
@@ -40,21 +52,71 @@ gqlQuery ::
   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)
+  -- 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)
+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
+  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
 
-toJsonError :: NonEmptyList ForeignError -> JsonDecodeError
+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.

src/Gargantext/Components/GraphQL/Endpoints.purs

@@ -9,7 +9,7 @@ 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)
 import Gargantext.Components.GraphQL.Contact (AnnuaireContact, annuaireContactQuery)
 import Gargantext.Components.GraphQL.Context as GQLCTX
 import Gargantext.Components.GraphQL.IMT as GQLIMT

src/Gargantext/Config/REST.purs

@@ -69,6 +69,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 +96,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 +142,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 }