{-| Module : Gargantext.API.GraphQL.Node Description : Copyright : (c) CNRS, 2017 License : AGPL + CECILL v3 Maintainer : team@gargantext.org Stability : experimental Portability : POSIX -} {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DuplicateRecordFields #-} module Gargantext.API.GraphQL.Node where import Data.Aeson ( Result(..), Value(..) ) import Data.Aeson.KeyMap qualified as KM import Data.Morpheus.Types ( GQLType ) import Gargantext.API.Admin.Auth.Types ( AuthenticatedUser ) import Gargantext.API.Auth.PolicyCheck ( nodeReadChecks, AccessPolicyManager ) import Gargantext.API.GraphQL.PolicyCheck (withPolicy) import Gargantext.API.GraphQL.Types ( GqlM ) import Gargantext.Core ( HasDBid(lookupDBid) ) import Gargantext.Database.Admin.Types.Node (NodeType) import Gargantext.Database.Admin.Types.Node qualified as NN import Gargantext.Database.Prelude (IsDBEnvExtra) -- , JSONB) import Gargantext.Database.Query.Table.Node (getClosestChildrenByType, getClosestParentIdByType, getNode) import Gargantext.Database.Schema.Node qualified as N import Gargantext.Prelude import PUBMED.Types qualified as PUBMED data Corpus = Corpus { id :: Int , name :: Text , parent_id :: Maybe Int , type_id :: Int } deriving (Show, Generic, GQLType) data Node = Node { id :: Int , name :: Text , parent_id :: Maybe Int , type_id :: Int , node_type :: Maybe NodeType } deriving (Show, Generic, GQLType) data CorpusArgs = CorpusArgs { corpus_id :: Int } deriving (Generic, GQLType) data NodeArgs = NodeArgs { node_id :: Int } deriving (Generic, GQLType) -- | Function to resolve user from a query. resolveNodes :: (IsDBEnvExtra env) => AuthenticatedUser -> AccessPolicyManager -> NodeArgs -> GqlM e env [Node] resolveNodes autUser mgr NodeArgs { node_id } = withPolicy autUser mgr (nodeReadChecks $ NN.UnsafeMkNodeId node_id) $ dbNodes node_id resolveNodesCorpus :: (IsDBEnvExtra env) => CorpusArgs -> GqlM e env [Corpus] resolveNodesCorpus CorpusArgs { corpus_id } = dbNodesCorpus corpus_id dbNodes :: (IsDBEnvExtra env) => Int -> GqlM e env [Node] dbNodes node_id = do node <- lift $ getNode $ NN.UnsafeMkNodeId node_id pure [toNode node] dbNodesCorpus :: (IsDBEnvExtra env) => Int -> GqlM e env [Corpus] dbNodesCorpus corpus_id = do corpus <- lift $ getNode $ NN.UnsafeMkNodeId corpus_id pure [toCorpus corpus] data NodeParentArgs = NodeParentArgs { node_id :: Int , parent_type :: NodeType } deriving (Generic, GQLType) data NodeChildrenArgs = NodeChildrenArgs { node_id :: Int , child_type :: NodeType } deriving (Generic, GQLType) resolveNodeParent :: (IsDBEnvExtra env) => NodeParentArgs -> GqlM e env [Node] resolveNodeParent NodeParentArgs { node_id, parent_type } = dbParentNodes node_id parent_type resolveNodeChildren :: (IsDBEnvExtra env) => NodeChildrenArgs -> GqlM e env [Node] resolveNodeChildren NodeChildrenArgs { node_id, child_type } = dbChildNodes node_id child_type dbParentNodes :: (IsDBEnvExtra env) => Int -> NodeType -> GqlM e env [Node] dbParentNodes node_id parentType = do -- let mParentType = readEither (T.unpack parent_type) :: Either Prelude.String NodeType -- case mParentType of -- Left err -> do -- lift $ printDebug "[dbParentNodes] error reading parent type" (T.pack err) -- pure [] -- Right parentType -> do mNodeId <- lift $ getClosestParentIdByType (NN.UnsafeMkNodeId node_id) parentType -- (fromNodeTypeId parent_type_id) case mNodeId of Nothing -> pure [] Just id -> do node <- lift $ getNode id pure [toNode node] dbChildNodes :: (IsDBEnvExtra env) => Int -> NodeType -> GqlM e env [Node] dbChildNodes node_id childType = do childIds <- lift $ getClosestChildrenByType (NN.UnsafeMkNodeId node_id) childType -- (fromNodeTypeId parent_type_id) children <- lift $ mapM getNode childIds pure $ toNode <$> children toNode :: NN.Node json -> Node toNode N.Node { .. } = Node { id = nid , name = _node_name , parent_id = NN.unNodeId <$> _node_parent_id , type_id = _node_typename , node_type = lookupDBid _node_typename } where nid = NN.unNodeId _node_id toCorpus :: NN.Node Value -> Corpus toCorpus N.Node { .. } = Corpus { id = NN.unNodeId _node_id , name = _node_name , parent_id = NN.unNodeId <$> _node_parent_id , type_id = _node_typename } pubmedAPIKeyFromValue :: Value -> Maybe PUBMED.APIKey pubmedAPIKeyFromValue (Object kv) = case KM.lookup "pubmed_api_key" kv of Nothing -> Nothing Just v -> case fromJSON v of Error _ -> Nothing Success v' -> Just v' pubmedAPIKeyFromValue _ = Nothing