Skip to content

P
purescript-gargantext
Verified Commit 1968de42 authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski
Browse files
Options

[graphql] implement new type errors

parent dc6f6f13
Pipeline #5549 failed with stage
    in 0 seconds
    Show whitespace changes
    Inline Side-by-side
    Showing with 144 additions and 132 deletions
    src/Gargantext/Components/Forest/Tree/Node/Action/ManageTeam.purs
    View file @ 1968de42
    ......@@ -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,17 +60,17 @@ 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
    team_members <- T.useBox team_members
    cpt { nodeId, session, team: { team_owner_username, team_members } } _ = do
    error <- T.useBox Nothing
    team_members <- T.useBox team_members
    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
    )
    ......
    src/Gargantext/Components/Forest/Tree/Node/Box.purs
    View file @ 1968de42
    ......@@ -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
    View file @ 1968de42
    ......@@ -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
    json <- clientQuery opts client queryName (getVarsTypeNames q <> toGqlQueryString q) (getVarsJson q)
    -- 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
    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/Components/GraphQL/Endpoints.purs
    View file @ 1968de42
    ......@@ -3,6 +3,7 @@ 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
    ......@@ -33,15 +34,17 @@ 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 }
    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")
    ......@@ -49,24 +52,31 @@ getNode session nodeId = do
    getNodeCorpus :: Session -> Int -> AffRESTError Corpus
    getNodeCorpus session corpusId = do
    { nodes_corpus } <- queryGql session "get nodes corpus" $
    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 -> Aff (Array Node)
    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 }
    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")
    ......@@ -104,7 +114,10 @@ updateUserEPOAPIToken session user_id api_token = do
    getUserInfo :: Session -> Int -> AffRESTError UserInfo
    getUserInfo session id = do
    { user_infos } <- queryGql session "get user infos" $ userInfoQuery `withVars` { id }
    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")
    ......@@ -113,8 +126,11 @@ getUserInfo session id = do
    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 }
    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")
    ......@@ -122,13 +138,19 @@ getAnnuaireContact session id = do
    getTreeFirstLevel :: Session -> Int -> AffRESTError TreeFirstLevel
    getTreeFirstLevel session id = do
    { tree } <- queryGql session "get tree first level" $ treeFirstLevelQuery `withVars` { id }
    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 }
    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
    ......@@ -154,7 +176,10 @@ deleteTeamMembership session sharedFolderId teamNodeId = do
    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
    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"
    ......@@ -165,10 +190,8 @@ getContextsForNgrams :: Session -> CorpusId -> Array String -> AffRESTError (Arr
    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
    ......@@ -186,8 +209,10 @@ updateNodeContextCategory session context_id node_id category = do
    getLanguages :: Session -> AffRESTError (Map.Map Lang GQLNLP.LanguageProperties)
    getLanguages session = do
    let query = GQLNLP.nlpQuery
    { languages } <- queryGql session "get languages" query
    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
    ......@@ -196,11 +221,11 @@ 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
    View file @ 1968de42
    ......@@ -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)
    ......
    Markdown is supported
    0% or
    You are about to add 0 people to the discussion. Proceed with caution.
    Finish editing this message first!
    Please register or to comment