[GraphQL] cleanup

Removed Tree endpoints. Cleaned up others.

This should be tested together with purescript changes:
purescript-gargantext@0a62761a

gargantext.cabal

@@ -342,7 +342,6 @@ library
       Gargantext.API.GraphQL.Node
       Gargantext.API.GraphQL.PolicyCheck
       Gargantext.API.GraphQL.Team
-      Gargantext.API.GraphQL.TreeFirstLevel
       Gargantext.API.GraphQL.Types
       Gargantext.API.GraphQL.UnPrefix
       Gargantext.API.GraphQL.User

src/Gargantext/API/GraphQL.hs

@@ -14,7 +14,7 @@ Portability : POSIX
 {-# LANGUAGE DuplicateRecordFields #-}  -- permit duplications for field names in multiple constructors
 {-# LANGUAGE KindSignatures #-}  -- for use of Endpoint (name :: Symbol)
 {-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE PartialTypeSignatures #-}  -- to automatically use suggested type hole signatures during compilation
+-- {-# LANGUAGE PartialTypeSignatures #-}  -- to automatically use suggested type hole signatures during compilation
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeOperators #-}
 
@@ -35,7 +35,6 @@ import Gargantext.API.GraphQL.IMT qualified as GQLIMT
 import Gargantext.API.GraphQL.NLP qualified as GQLNLP
 import Gargantext.API.GraphQL.Node qualified as GQLNode
 import Gargantext.API.GraphQL.Team qualified as GQLTeam
-import Gargantext.API.GraphQL.TreeFirstLevel qualified as GQLTree
 import Gargantext.API.GraphQL.User qualified as GQLUser
 import Gargantext.API.GraphQL.UserInfo qualified as GQLUserInfo
 import Gargantext.API.Prelude (GargM)
@@ -50,24 +49,22 @@ import Servant.Auth.Server qualified as SAS
 import Servant.Server.Generic (AsServerT)
 
 
+
 -- | Represents possible GraphQL queries.
 data Query m
   = Query
-    { annuaire_contacts   :: GQLA.AnnuaireContactArgs -> m [GQLA.AnnuaireContact]
-    , context_ngrams      :: GQLCTX.ContextNgramsArgs -> m [Text]
-    , contexts            :: GQLCTX.NodeContextArgs -> m [GQLCTX.NodeContextGQL]
-    , contexts_for_ngrams :: GQLCTX.ContextsForNgramsArgs -> m [GQLCTX.ContextGQL]
-    , imt_schools         :: m [GQLIMT.School]
+    { annuaireContact   :: GQLA.AnnuaireContactArgs -> m GQLA.AnnuaireContact
+    , context :: GQLCTX.ContextByIdAndNodeArgs -> m GQLCTX.NodeContextGQL
+    , contextsForNgrams :: GQLCTX.ContextsForNgramsArgs -> m [GQLCTX.ContextGQL]
+    , corpus        :: GQLNode.CorpusByIdArgs -> m GQLNode.Corpus
     , languages           :: m [GQLNLP.LanguageTuple]
-    , nodes               :: GQLNode.NodeArgs -> m [GQLNode.Node]
-    , nodes_corpus        :: GQLNode.CorpusArgs -> m [GQLNode.Corpus]
-    , node_children       :: GQLNode.NodeChildrenArgs -> m [GQLNode.Node]
-    , node_parent         :: GQLNode.NodeParentArgs -> m [GQLNode.Node]
-    , user_infos          :: GQLUserInfo.UserInfoArgs -> m [GQLUserInfo.UserInfo]
-    , users               :: GQLUser.UserArgs -> m [GQLUser.User m]
-    , tree                :: GQLTree.TreeArgs -> m (GQLTree.TreeFirstLevel m)
+    , ngramsForContextAndListId :: GQLCTX.NgramsForContextAndListArgs -> m [Text]
+    , node               :: GQLNode.NodeByIdArgs -> m GQLNode.Node
+    , nodes              :: GQLNode.NodesArgs -> m [GQLNode.Node]
+    , schools         :: m [GQLIMT.School]
     , team                :: GQLTeam.TeamArgs -> m GQLTeam.Team
-    , tree_branch         :: GQLTree.BreadcrumbArgs -> m (GQLTree.BreadcrumbInfo)
+    , user               :: GQLUser.UserByIdArgs -> m (GQLUser.User m)
+    , userInfo          :: GQLUserInfo.UserInfoArgs -> m GQLUserInfo.UserInfo
     } deriving (Generic, GQLType)
 
 data Mutation m
@@ -104,21 +101,19 @@ rootResolver
   -> RootResolver (GargM env BackendInternalError) e Query Mutation Undefined
 rootResolver authenticatedUser policyManager =
   defaultRootResolver
-    { queryResolver = Query { annuaire_contacts   = GQLA.resolveAnnuaireContacts
-                            , context_ngrams      = GQLCTX.resolveContextNgrams
-                            , contexts            = GQLCTX.resolveNodeContext
-                            , contexts_for_ngrams = GQLCTX.resolveContextsForNgrams
-                            , imt_schools         = GQLIMT.resolveSchools
-                            , languages           = GQLNLP.resolveLanguages
-                            , nodes               = GQLNode.resolveNodes authenticatedUser policyManager
-                            , nodes_corpus        = GQLNode.resolveNodesCorpus
-                            , node_children       = GQLNode.resolveNodeChildren
-                            , node_parent         = GQLNode.resolveNodeParent
-                            , user_infos          = GQLUserInfo.resolveUserInfos authenticatedUser policyManager
-                            , users               = GQLUser.resolveUsers authenticatedUser policyManager
-                            , tree                = GQLTree.resolveTree authenticatedUser policyManager
+    { queryResolver = Query { annuaireContact   = GQLA.getAnnuaireContactById
+                            , context = GQLCTX.getContextByIdAndNode
+                            , contextsForNgrams = GQLCTX.getContextsForNgrams
+                            , corpus        = GQLNode.getCorpusById
+                            , languages           = GQLNLP.getLanguages
+                            , ngramsForContextAndListId = GQLCTX.getNgramsForContextAndListId
+                            , node               = GQLNode.getNodeById authenticatedUser policyManager
+                            , nodes              = GQLNode.filterNodes
+                            , schools         = GQLIMT.getSchools
                             , team                = GQLTeam.resolveTeam
-                            , tree_branch         = GQLTree.resolveBreadcrumb }
+                            , user               = GQLUser.getUserById authenticatedUser policyManager
+                            , userInfo          = GQLUserInfo.getUserInfo authenticatedUser policyManager
+                            }
     , mutationResolver = Mutation { update_user_info       = GQLUserInfo.updateUserInfo
                                   , update_user_pubmed_api_key = GQLUser.updateUserPubmedAPIKey
                                   , update_user_epo_api_user = GQLUser.updateUserEPOAPIUser
@@ -175,3 +170,4 @@ api = GraphQLAPI $ \case
                            , playgroundEp = Playground $ pure httpPlayground
                            }
   _ -> panicTrace "401 in graphql" -- SAS.throwAll (_ServerError # err401)
+

src/Gargantext/API/GraphQL/Annuaire.hs

@@ -16,18 +16,13 @@ module Gargantext.API.GraphQL.Annuaire where
 
 import Control.Lens (Traversal', _Just, ix)
 import Data.Morpheus.Types ( GQLType )
-import Gargantext.Database.Admin.Types.Hyperdata.Contact
-  ( HyperdataContact
-  , ContactWho
-  , cw_firstName
-  , cw_lastName
-  , hc_who, ContactWhere, hc_where, cw_organization, cw_labTeamDepts, cw_role, cw_office, cw_country, cw_city, cw_touch, ct_mail, ct_phone, ct_url, hc_title, hc_source)
+import Gargantext.API.GraphQL.Types (GqlM, gqlHead)
+import Gargantext.Database.Admin.Types.Hyperdata.Contact ( HyperdataContact, ContactWho, cw_firstName, cw_lastName, hc_who, ContactWhere, hc_where, cw_organization, cw_labTeamDepts, cw_role, cw_office, cw_country, cw_city, cw_touch, ct_mail, ct_phone, ct_url, hc_title, hc_source)
 import Gargantext.Database.Admin.Types.Node (ContextId (..))
 import Gargantext.Database.Prelude (IsDBEnvExtra)
 import Gargantext.Database.Query.Table.Context (getContextWith)
 import Gargantext.Database.Schema.Node (node_hyperdata)
 import Gargantext.Prelude
-import Gargantext.API.GraphQL.Types (GqlM)
 
 data AnnuaireContact = AnnuaireContact
   { ac_title        :: !(Maybe Text)
@@ -50,14 +45,16 @@ data AnnuaireContact = AnnuaireContact
 -- | Arguments to the "user info" query.
 data AnnuaireContactArgs
   = AnnuaireContactArgs
-    { contact_id :: Int
+    { contactId :: Int
     } deriving (Generic, GQLType)
 
 -- | Function to resolve user from a query.
-resolveAnnuaireContacts
+getAnnuaireContactById
   :: (IsDBEnvExtra env)
-  => AnnuaireContactArgs -> GqlM e env [AnnuaireContact]
-resolveAnnuaireContacts AnnuaireContactArgs { contact_id } = dbAnnuaireContacts contact_id
+  => AnnuaireContactArgs -> GqlM e env AnnuaireContact
+getAnnuaireContactById AnnuaireContactArgs { contactId } = do
+  dbAnnuaireContacts contactId
+    >>= gqlHead ("[getAnnuaireContactById] Node does not exist: ", contactId)
 
 -- | Inner function to fetch the user from DB.
 dbAnnuaireContacts
@@ -71,6 +68,9 @@ dbAnnuaireContacts contact_id = do
 
   -- FIXME(adinapoli) This function seems a bit iffy, unless a 'contact_id'
   -- is just a synonym for a 'ContextId'.
+  -- NOTE(seeg) It seems that Annuaire stuff is experimental. I created
+  -- an annuaire node (has to be top-level like corpus), inserted an annuaire contact
+  -- and it appears in the context table with typename = 41. So this seems to be correct.
   c <- lift $ getContextWith (UnsafeMkContextId contact_id) (Proxy :: Proxy HyperdataContact)
   pure [toAnnuaireContact (contact_id, c ^. node_hyperdata)]
 

src/Gargantext/API/GraphQL/Context.hs

@@ -29,6 +29,7 @@ import Gargantext.API.Admin.Auth.Types ( AuthenticatedUser )
 import Gargantext.API.Auth.PolicyCheck ( nodeWriteChecks, AccessPolicyManager )
 import Gargantext.API.Errors.Types ( BackendInternalError )
 import Gargantext.API.GraphQL.PolicyCheck (withPolicy)
+import Gargantext.API.GraphQL.Types (gqlHead)
 import Gargantext.API.Prelude (GargM)
 import Gargantext.Core.Types.Search (HyperdataRow(..), toHyperdataRow)
 import Gargantext.Database.Admin.Types.Hyperdata.Document ( HyperdataDocument )
@@ -87,10 +88,10 @@ data NodeContextGQL = NodeContextGQL
 -- | Arguments to the "context node" query.
 --   "context_id" is doc id
 --   "node_id" is it's corpus id
-data NodeContextArgs
-  = NodeContextArgs
-    { context_id :: Int
-    , node_id    :: Int
+data ContextByIdAndNodeArgs
+  = ContextByIdAndNodeArgs
+    { contextId :: Int
+    , nodeId    :: Int
     } deriving (Generic, GQLType)
 
 data ContextsForNgramsArgs
@@ -106,10 +107,10 @@ data NodeContextCategoryMArgs = NodeContextCategoryMArgs
   , category   :: Int
   } deriving (Generic, GQLType)
 
-data ContextNgramsArgs
-  = ContextNgramsArgs
-    { context_id  :: Int
-    , list_id     :: Int }
+data NgramsForContextAndListArgs
+  = NgramsForContextAndListArgs
+    { contextId  :: Int
+    , listId     :: Int }
     deriving (Generic, GQLType)
 
 type GqlM e env = Resolver QUERY e (GargM env BackendInternalError)
@@ -118,23 +119,27 @@ type GqlM' e env a = ResolverM e (GargM env BackendInternalError) a
 -- GQL API
 
 -- | Function to resolve context from a query.
-resolveNodeContext
+-- Given node_id and context_id, return that Context.
+getContextByIdAndNode
   :: (IsDBEnvExtra env)
-  => NodeContextArgs -> GqlM e env [NodeContextGQL]
-resolveNodeContext NodeContextArgs { context_id, node_id } =
-  dbNodeContext context_id node_id
+  => ContextByIdAndNodeArgs -> GqlM e env NodeContextGQL
+getContextByIdAndNode ContextByIdAndNodeArgs { contextId, nodeId } =
+  dbNodeContext contextId nodeId
+    >>= gqlHead ("[getContextByIdAndNode] context does not exist: ", (contextId, nodeId))
 
-resolveContextsForNgrams
+getContextsForNgrams
   :: (IsDBEnvExtra env)
   => ContextsForNgramsArgs -> GqlM e env [ContextGQL]
-resolveContextsForNgrams ContextsForNgramsArgs { corpus_id, ngrams_terms, and_logic } =
+getContextsForNgrams ContextsForNgramsArgs { corpus_id, ngrams_terms, and_logic } =
   dbContextForNgrams corpus_id ngrams_terms and_logic
 
-resolveContextNgrams
+-- Tokenizes given context in list id. This uses PostgreSQL FTS
+-- tokenization which isn't perfect.
+getNgramsForContextAndListId
   :: (IsDBEnvExtra env)
-  => ContextNgramsArgs -> GqlM e env [Text]
-resolveContextNgrams ContextNgramsArgs { context_id, list_id } =
-  dbContextNgrams context_id list_id
+  => NgramsForContextAndListArgs -> GqlM e env [Text]
+getNgramsForContextAndListId NgramsForContextAndListArgs { contextId, listId } =
+  dbContextNgrams contextId listId
 
 -- DB
 

src/Gargantext/API/GraphQL/IMT.hs

@@ -15,7 +15,7 @@ Portability : POSIX
 module Gargantext.API.GraphQL.IMT
   ( School(..)
   , SchoolsArgs(..)
-  , resolveSchools
+  , getSchools
   )
   where
 
@@ -29,6 +29,6 @@ newtype SchoolsArgs
     deriving stock (Generic)
     deriving anyclass (GQLType)
 
-resolveSchools
+getSchools
   :: GqlM e env [School]
-resolveSchools = pure $ schools
+getSchools = pure $ schools

src/Gargantext/API/GraphQL/NLP.hs

@@ -17,7 +17,7 @@ module Gargantext.API.GraphQL.NLP
   , LanguagesArgs(..)
   , LanguagesMap
   , LanguageTuple
-  , resolveLanguages
+  , getLanguages
   )
   where
 
@@ -49,9 +49,9 @@ data NLPServer = NLPServer
   }
   deriving (Show, Eq, Generic, GQLType)
 
-resolveLanguages
+getLanguages
   :: HasNLPServer env => GqlM e env [LanguageTuple]
-resolveLanguages = do
+getLanguages = do
   lift $ do
     ns <- view nlpServer
     printDebug "[resolveLanguages] nlpServer" ns

src/Gargantext/API/GraphQL/Node.hs

@@ -9,23 +9,29 @@ Portability : POSIX
 -}
 
 
+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE TemplateHaskellQuotes #-}
+-- {-# LANGUAGE TypeFamilies #-}
 
 module Gargantext.API.GraphQL.Node where
 
 import Data.Aeson ( Result(..), Value(..) )
 import Data.Aeson.KeyMap qualified as KM
-import Data.Morpheus.Types ( GQLType )
+import Data.Morpheus.Server.Types (fieldDirective', typeDirective)
+import Data.Morpheus.Types ( GQLType(..), Describe(..) )
 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.API.GraphQL.Types ( GqlM, gqlHead )
+import Gargantext.Core ( HasDBid(lookupDBid), fromDBid )
 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.Query.Table.Node (getDirectChildrenByType, getClosestParentIdByType, getNode)
+import Gargantext.Database.Query.Tree qualified as T
 import Gargantext.Database.Schema.Node qualified as N
 import Gargantext.Prelude
 import PUBMED.Types qualified as PUBMED
@@ -43,32 +49,85 @@ data Node = Node
   , parent_id    :: Maybe Int
   , type_id      :: Int
   , node_type    :: Maybe NodeType
-  } deriving (Show, Generic, GQLType)
+  } deriving (Show, Eq, Generic)
+instance GQLType Node where
+  directives _ = typeDirective (Describe "Node is the basic entity type in Gargantext")
+instance Ord Node where
+  compare (Node { id = id1 }) (Node { id = id2 }) = compare id1 id2
+
+
 
-data CorpusArgs
-  = CorpusArgs
-    { corpus_id :: Int
+data CorpusByIdArgs
+  = CorpusByIdArgs
+    { id :: Int
     } deriving (Generic, GQLType)
 
-data NodeArgs
-  = NodeArgs
-    { node_id :: Int
+data NodeByIdArgs
+  = NodeByIdArgs
+    { id :: Int
     } deriving (Generic, GQLType)
 
+-- | TODO This is not ideal. It would be better to derive
+-- NamedResolvers for Node.children, Node.parent
+-- https://morpheusgraphql.com/server#named-resolvers
+data NodesArgs
+  = NodesArgs
+    { parentId :: Maybe Int
+    , containsChildId :: Maybe Int
+    , deepChildId :: Maybe Int
+    , nodeType :: Maybe NodeType }
+    deriving (Generic)
+instance GQLType NodesArgs where
+  -- type KIND NodesArgs = TYPE
+  directives _ =
+    typeDirective (Describe "Arguments to fetch nodes")
+    <> fieldDirective' 'parentId Describe { text = "If not null, will fetch nodes having given id as parent (i.e. child nodes)" }
+    <> fieldDirective' 'containsChildId Describe { text = "If not null, wil fetch nodes having given id as child (i.e. parent nodes) "}
+    <> fieldDirective' 'deepChildId Describe { text = "If not null, will fetch nodes that have given id as a deeply nested child (i.e. ancestor nodes). Can be used to fetch breadcrumbs" }
+    <> fieldDirective' 'nodeType Describe { text = "Filters out resulting nodes by given node type" }
+
 -- | Function to resolve user from a query.
-resolveNodes
+getNodeById
   :: (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
+  -> NodeByIdArgs
+  -> GqlM e env Node
+getNodeById autUser mgr NodeByIdArgs { id } =
+  withPolicy autUser mgr (nodeReadChecks $ NN.UnsafeMkNodeId id) $ dbNodes id
+    >>= gqlHead ("[getNodeById] node not found", id)
 
-resolveNodesCorpus
+
+getCorpusById
+  :: (IsDBEnvExtra env)
+  => CorpusByIdArgs -> GqlM e env Corpus
+getCorpusById CorpusByIdArgs { id } =
+  dbNodesCorpus id
+    >>= gqlHead ("[getCorpusById] corpus does not exist", id)
+
+filterNodes
   :: (IsDBEnvExtra env)
-  => CorpusArgs -> GqlM e env [Corpus]
-resolveNodesCorpus CorpusArgs { corpus_id } = dbNodesCorpus corpus_id
+  => NodesArgs
+  -> GqlM e env [Node]
+filterNodes NodesArgs { .. } = do
+  children <- case parentId of
+    Nothing -> pure []
+    Just pId -> dbChildNodes pId nodeType
+  parents <- case containsChildId of
+    Nothing -> pure []
+    Just ccId -> dbParentNodes ccId nodeType
+  ancestors <- case deepChildId of
+    Nothing -> pure []
+    Just dcId -> do
+      let nts = maybe NN.allNodeTypes (\nt -> [nt]) nodeType
+      ancestors' <- lift $ T.recursiveParents (NN.UnsafeMkNodeId dcId) nts
+      pure $ (\(T.DbTreeNode { .. }) -> Node { id = NN.unNodeId _dt_nodeId
+                                            , name = _dt_name
+                                            , parent_id = NN.unNodeId <$> _dt_parentId
+                                            , type_id = _dt_typeId
+                                            , node_type = Just $ fromDBid _dt_typeId }) <$> ancestors'
+  pure $ children <> parents <> ancestors
+
 
 dbNodes
   :: (IsDBEnvExtra env)
@@ -80,54 +139,36 @@ dbNodes node_id = do
 dbNodesCorpus
   :: (IsDBEnvExtra env)
   => Int -> GqlM e env [Corpus]
-dbNodesCorpus corpus_id = do
-  corpus <- lift $ getNode $ NN.UnsafeMkNodeId corpus_id
+dbNodesCorpus corpusId = do
+  corpus <- lift $ getNode $ NN.UnsafeMkNodeId corpusId
   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
+  => Int
+  -> Maybe NodeType
+  -> GqlM e env [Node]
+dbParentNodes node_id parentType = lift $ 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]
+  mNodeId <- getClosestParentIdByType (NN.UnsafeMkNodeId node_id) parentType -- (fromNodeTypeId parent_type_id)
+  case mNodeId of
+    Nothing -> pure []
+    Just id -> do
+      node <- 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
+             => Int
+             -> Maybe NodeType
+             -> GqlM e env [Node]
+dbChildNodes node_id childType = lift $ do
+  childIds <- getDirectChildrenByType (NN.UnsafeMkNodeId node_id) childType -- (fromNodeTypeId parent_type_id)
+  children <- mapM getNode childIds
   pure $ toNode <$> children
 
 toNode :: NN.Node json -> Node

src/Gargantext/API/GraphQL/TreeFirstLevel.hs

-{-|
-Module      : Gargantext.API.GraphQL.TreeFirstLevel
-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.TreeFirstLevel where
-
-import Data.Morpheus.Types (GQLType)
-import Gargantext.API.Admin.Auth.Types ( AuthenticatedUser(..) )
-import Gargantext.API.Auth.PolicyCheck (AccessPolicyManager, nodeReadChecks)
-import Gargantext.API.GraphQL.PolicyCheck (withPolicy)
-import Gargantext.API.GraphQL.Types ( GqlM )
-import Gargantext.Core (fromDBid)
--- import Gargantext.Core.Types (ContextId, CorpusId, ListId)
-import Gargantext.Core.Types.Main ( Tree(..), _tn_node, _tn_children, NodeTree(..), _nt_name )
-import Gargantext.Database.Admin.Config ()
-import Gargantext.Database.Admin.Types.Node (allNodeTypes, NodeId(..), NodeType)
-import Gargantext.Database.Admin.Types.Node qualified as NN
-import Gargantext.Database.Prelude (IsDBEnvExtra)
-import Gargantext.Database.Query.Table.Node (getNode)
-import Gargantext.Database.Query.Tree qualified as T
-import Gargantext.Database.Schema.Node (NodePoly(_node_parent_id))
-import Gargantext.Database.Schema.Node qualified as N
-import Gargantext.Prelude
-
-data TreeArgs = TreeArgs
-  {
-    root_id :: Int
-  } deriving (Generic, GQLType)
-
-data TreeNode = TreeNode
-  {
-    name      :: Text
-  , id        :: Int
-  , node_type :: NodeType
-  , parent_id :: Maybe Int
-  } deriving (Generic, GQLType)
-
-data TreeFirstLevel m = TreeFirstLevel
-  {
-    root     :: TreeNode
-  , parent   :: m (Maybe TreeNode)
-  , children :: [TreeNode]
-  } deriving (Generic, GQLType)
-  
-    
-data BreadcrumbArgs = BreadcrumbArgs
-  {
-    node_id :: Int
-  } deriving (Generic, GQLType)
-
-data BreadcrumbInfo = BreadcrumbInfo
-  {
-    parents :: [TreeNode]
-  } deriving (Generic, GQLType)
-
-type ParentId = Maybe NodeId
-
-resolveTree :: (IsDBEnvExtra env)
-            => AuthenticatedUser
-            -> AccessPolicyManager
-            -> TreeArgs
-            -> GqlM e env (TreeFirstLevel (GqlM e env))
-resolveTree autUser mgr TreeArgs { root_id } =
-  withPolicy autUser mgr (nodeReadChecks $ UnsafeMkNodeId root_id) $ dbTree (_auth_user_id autUser) root_id
-
-dbTree :: (IsDBEnvExtra env) =>
-          NN.UserId -> Int -> GqlM e env (TreeFirstLevel (GqlM e env))
-dbTree loggedInUserId root_id = do
-  let rId = UnsafeMkNodeId root_id
-  t <- lift $ T.tree loggedInUserId T.TreeFirstLevel rId allNodeTypes
-  n <- lift $ getNode $ UnsafeMkNodeId root_id
-  let pId = toParentId n
-  pure $ toTree rId pId t
-  where
-    toParentId N.Node { _node_parent_id } = _node_parent_id
-
-
-toTree :: (IsDBEnvExtra env) => NodeId -> ParentId -> Tree NodeTree -> TreeFirstLevel (GqlM e env)
-toTree rId pId TreeN { _tn_node, _tn_children } = TreeFirstLevel
-  { parent   = resolveParent pId
-  , root     = toTreeNode pId _tn_node
-  , children = map childrenToTreeNodes $ zip _tn_children $ repeat rId
-  }
-
-toTreeNode :: ParentId -> NodeTree -> TreeNode
-toTreeNode pId NodeTree { _nt_name, _nt_id, _nt_type } = TreeNode { name = _nt_name, id = NN._NodeId _nt_id, node_type = _nt_type, parent_id = NN._NodeId <$> pId}
-
-childrenToTreeNodes :: (Tree NodeTree, NodeId) -> TreeNode
-childrenToTreeNodes (TreeN {_tn_node}, rId) = toTreeNode (Just rId) _tn_node
-
-resolveParent :: (IsDBEnvExtra env) => Maybe NodeId -> GqlM e env (Maybe TreeNode)
-resolveParent (Just pId) = do
-  node <- lift $ getNode pId
-  pure $ nodeToTreeNode node
-resolveParent Nothing = pure Nothing
-
-
-nodeToTreeNode :: HasCallStack => NN.Node json -> Maybe TreeNode
-nodeToTreeNode N.Node {..} =
- if (fromDBid _node_typename /= NN.NodeFolderShared) && (fromDBid _node_typename /= NN.NodeTeam)
-   then
-     Just TreeNode { id        = NN.unNodeId _node_id
-                   , name      = _node_name
-                   , node_type = fromDBid _node_typename
-                   , parent_id = NN.unNodeId <$> _node_parent_id
-                   }
-   else
-     Nothing
-
-resolveBreadcrumb :: (IsDBEnvExtra env) => BreadcrumbArgs -> GqlM e env BreadcrumbInfo
-resolveBreadcrumb BreadcrumbArgs { node_id } = dbRecursiveParents node_id
-
-convertDbTreeToTreeNode :: HasCallStack => T.DbTreeNode -> TreeNode
-convertDbTreeToTreeNode T.DbTreeNode { _dt_name, _dt_nodeId, _dt_typeId, _dt_parentId } =
-  TreeNode
-    { name = _dt_name
-    , id = NN.unNodeId _dt_nodeId
-    , node_type = fromDBid _dt_typeId
-    , parent_id = NN.unNodeId <$> _dt_parentId
-    }
-
-
-dbRecursiveParents :: (IsDBEnvExtra env) => Int -> GqlM e env BreadcrumbInfo
-dbRecursiveParents nodeId = do
-  let nId = UnsafeMkNodeId nodeId
-  dbParents <- lift $ T.recursiveParents nId allNodeTypes
-  let treeNodes = map convertDbTreeToTreeNode dbParents
-  pure $ BreadcrumbInfo { parents = treeNodes }

src/Gargantext/API/GraphQL/Types.hs

 
 module Gargantext.API.GraphQL.Types where
 
+import Control.Monad.Fail (fail)
 import Data.Morpheus.Types
+import Data.Text qualified as T
 import Gargantext.API.Prelude
 import Gargantext.API.Errors.Types
+-- import Gargantext.Core.Types (NodeId(UnsafeMkNodeId))
+-- import Gargantext.Database.Query.Table.Node.Error (NodeError(NodeLookupFailed), NodeLookupError(NodeDoesNotExist))
+import Gargantext.Prelude
 
 type GqlM e env = Resolver QUERY e (GargM env BackendInternalError)
 type GqlM' e env a = ResolverM e (GargM env BackendInternalError) a
+
+-- nodeDoesNotExistError :: Int -> BackendInternalError
+-- nodeDoesNotExistError nodeId =
+--   InternalNodeError $ NodeLookupFailed $ NodeDoesNotExist $ UnsafeMkNodeId nodeId
+
+gqlHead :: Show params => (Text, params) -> [a] -> GqlM e env a
+gqlHead (err, params) els =
+  case head els of
+    Just el -> pure el
+    Nothing -> fail $ T.unpack err <> show params

src/Gargantext/API/GraphQL/User.hs

@@ -18,7 +18,7 @@ import Data.Morpheus.Types ( GQLType )
 import Gargantext.API.Admin.Auth.Types (AuthenticatedUser)
 import Gargantext.API.Auth.PolicyCheck (AccessPolicyManager, nodeReadChecks)
 import Gargantext.API.GraphQL.PolicyCheck (withPolicy)
-import Gargantext.API.GraphQL.Types (GqlM, GqlM')
+import Gargantext.API.GraphQL.Types (GqlM, GqlM', gqlHead)
 import Gargantext.Core.Types (NodeId(..), UserId)
 import Gargantext.Core.Types.Individu qualified as Individu
 import Gargantext.Database.Admin.Types.Hyperdata (HyperdataUser(..))
@@ -35,9 +35,9 @@ data User m = User
   deriving (Generic, GQLType)
 
 -- | Arguments to the "user" query.
-data UserArgs
-  = UserArgs
-    { user_id :: Int
+data UserByIdArgs
+  = UserByIdArgs
+    { id :: Int
     } deriving (Generic, GQLType)
 
 data UserPubmedAPIKeyMArgs
@@ -59,15 +59,16 @@ data UserEPOAPITokenMArgs
     deriving (Generic, GQLType)
 
 -- | Function to resolve user from a query.
-resolveUsers
+getUserById
   :: (IsDBEnvExtra env)
   => AuthenticatedUser
   -> AccessPolicyManager
-  -> UserArgs
-  -> GqlM e env [User (GqlM e env)]
-resolveUsers autUser mgr UserArgs { user_id } = do
+  -> UserByIdArgs
+  -> GqlM e env (User (GqlM e env))
+getUserById autUser mgr UserByIdArgs { id } = do
   -- We are given the /node id/ of the logged-in user.
-  withPolicy autUser mgr (nodeReadChecks $ UnsafeMkNodeId user_id) $ dbUsers user_id
+  withPolicy autUser mgr (nodeReadChecks $ UnsafeMkNodeId id) $ dbUsers id
+    >>= gqlHead ("[getUserById] user not found", id)
 
 -- | Inner function to fetch the user from DB.
 dbUsers :: (IsDBEnvExtra env)

src/Gargantext/API/GraphQL/UserInfo.hs

@@ -44,7 +44,7 @@ import Gargantext.Database.Admin.Types.Hyperdata.Contact
 import Gargantext.API.Admin.Auth.Types (AuthenticatedUser)
 import Gargantext.API.Auth.PolicyCheck (AccessPolicyManager, userMe)
 import Gargantext.API.GraphQL.PolicyCheck (withPolicy)
-import Gargantext.API.GraphQL.Types (GqlM, GqlM')
+import Gargantext.API.GraphQL.Types (GqlM, GqlM', gqlHead)
 import Gargantext.API.GraphQL.Utils (AuthStatus(Invalid, Valid), authUser)
 import Gargantext.Core.Config (HasJWTSettings)
 import Gargantext.Core.Types (UserId(..))
@@ -82,7 +82,7 @@ instance VisitType UserInfo where
 -- | Arguments to the "user info" query.
 data UserInfoArgs
   = UserInfoArgs
-    { user_id :: Int
+    { userId :: Int
     } deriving (Generic, GQLType)
 
 -- | Arguments to the "user info" mutation,
@@ -108,14 +108,15 @@ data UserInfoMArgs
     } deriving (Generic, GQLType)
 
 -- | Function to resolve user from a query.
-resolveUserInfos
+getUserInfo
   :: (IsDBEnvExtra env)
   => AuthenticatedUser
   -> AccessPolicyManager
-  -> UserInfoArgs -> GqlM e env [UserInfo]
-resolveUserInfos autUser mgr UserInfoArgs { user_id } =
+  -> UserInfoArgs -> GqlM e env UserInfo
+getUserInfo autUser mgr UserInfoArgs { userId } =
   -- FIXME(adn) we should use a proper policy, not 'alwaysAllow'.
-  withPolicy autUser mgr (userMe $ UnsafeMkUserId user_id) $ dbUsers (UnsafeMkUserId user_id)
+  withPolicy autUser mgr (userMe $ UnsafeMkUserId userId) $ dbUsers (UnsafeMkUserId userId)
+    >>= gqlHead ("[getUserInfo] user info not found", userId)
 
 -- | Mutation for user info
 updateUserInfo

src/Gargantext/API/Node.hs

@@ -247,7 +247,7 @@ genericNodeAPI' _ authenticatedUser targetNode =  Named.NodeAPI
                            Update.api targetNode
   , deleteEp           = withPolicy authenticatedUser (nodeWriteChecks targetNode) $
                            Action.deleteNode userRootId targetNode
-  , childrenAPI        = Named.ChildrenAPI $ getChildren targetNode (Proxy :: Proxy a)
+  , childrenAPI        = Named.ChildrenAPI { summaryChildrenEp = getChildren targetNode (Proxy :: Proxy a) }
   , tableAPI           = tableApi targetNode
   , tableNgramsAPI     = apiNgramsTableCorpus targetNode
   , catAPI             = Named.CatAPI $ catApi targetNode

src/Gargantext/API/Node/Document/Export.hs

@@ -65,7 +65,7 @@ getDocumentsJSON nodeUserId pId = do
 get_document_json :: IsGargServer err env m => NodeId -> DocId -> m DocumentExport
 get_document_json nodeUserId pId = do
   uId <- view node_user_id <$> getNodeUser nodeUserId
-  mcId <- getClosestParentIdByType pId NodeCorpus
+  mcId <- getClosestParentIdByType pId (Just NodeCorpus)
   let cId = maybe (panicTrace "[G.A.N.D.Export] Node has no parent") identity mcId
   docs <- runViewDocuments cId False Nothing Nothing Nothing Nothing Nothing
   pure DocumentExport { _de_documents = mapFacetDoc uId <$> docs

src/Gargantext/API/Node/DocumentUpload.hs

@@ -71,7 +71,7 @@ documentUpload :: (FlowCmdM env err m)
                -> DocumentUpload
                -> m [DocId]
 documentUpload nId doc = do
-  mcId <- getClosestParentIdByType' nId NodeCorpus
+  mcId <- getClosestParentIdByType' nId (Just NodeCorpus)
   let cId = case mcId of
         Just c  -> c
         Nothing -> panicTrace $ T.pack $ "[G.A.N.DU] Node has no corpus parent: " <> show nId

src/Gargantext/API/Node/DocumentsFromWriteNodes.hs

@@ -73,7 +73,7 @@ documentsFromWriteNodes authenticatedUser nId Params { selection, lang, paragrap
   markStarted 2 jobHandle
   markProgress 1 jobHandle
 
-  mcId <- getClosestParentIdByType' nId NodeCorpus
+  mcId <- getClosestParentIdByType' nId (Just NodeCorpus)
   cId <- case mcId of
     Just cId -> pure cId
     Nothing -> do
@@ -82,7 +82,7 @@ documentsFromWriteNodes authenticatedUser nId Params { selection, lang, paragrap
       markFailed (Just $ UnsafeMkHumanFriendlyErrorText "The requested node has no corpus parent.") jobHandle
       panicTrace msg
 
-  frameWriteIds <- getChildrenByType nId Notes
+  frameWriteIds <- getChildrenByType nId (Just Notes)
 
   -- https://write.frame.gargantext.org/<frame_id>/download
   frameWrites <- mapM (\id -> getNodeWith id (Proxy :: Proxy HyperdataFrame)) frameWriteIds

src/Gargantext/API/Node/FrameCalcUpload.hs

@@ -89,7 +89,7 @@ frameCalcUploadAsync authenticatedUser nId (FrameCalcUpload _wtf_lang _wtf_selec
   PSQL.Oid oId <- createLargeObject body
 
   -- printDebug "body" body
-  mCId <- getClosestParentIdByType nId NodeCorpus
+  mCId <- getClosestParentIdByType nId (Just NodeCorpus)
   -- printDebug "[frameCalcUploadAsync] mCId" mCId
 
   case mCId of

src/Gargantext/API/Node/Update.hs

@@ -163,10 +163,10 @@ updateNode tId
   markProgress 1 jobHandle
 
   _ <- getNode tId
-  childTexts <- getChildrenByType tId NodeTexts
-  childGraphs <- getChildrenByType tId NodeGraph
-  childPhylos <- getChildrenByType tId NodePhylo
-  childNodeLists <- getChildrenByType tId NodeList
+  childTexts <- getChildrenByType tId (Just NodeTexts)
+  childGraphs <- getChildrenByType tId (Just NodeGraph)
+  childPhylos <- getChildrenByType tId (Just NodePhylo)
+  childNodeLists <- getChildrenByType tId (Just NodeList)
 
   mapM_ (\cId -> updateNode cId (UpdateNodeParamsTexts methodTexts) jobHandle) childTexts
   markProgress 1 jobHandle

src/Gargantext/Core/Viz/Graph/API.hs

@@ -60,7 +60,7 @@ getGraph nId = do
     graph  = nodeGraph ^. node_hyperdata . hyperdataGraph
     camera = nodeGraph ^. node_hyperdata . hyperdataCamera
 
-  mcId <- getClosestParentIdByType nId NodeCorpus
+  mcId <- getClosestParentIdByType nId (Just NodeCorpus)
   let cId = maybe (panic "[G.V.G.API] Node has no parent") identity mcId
 
   -- printDebug "[getGraph] getting list for cId" cId
@@ -117,7 +117,7 @@ recomputeGraph nId bridgeMethod maybeSimilarity maybeStrength nt1 nt2 force' = d
                         Just  mr -> fromMaybe Strong mr
                    Just r  -> r
 
-  mcId <- getClosestParentIdByType nId NodeCorpus
+  mcId <- getClosestParentIdByType nId (Just NodeCorpus)
   let cId = maybe (panic "[G.V.G.API] Node has no parent") identity mcId
 
   listId  <- defaultList cId
@@ -257,7 +257,7 @@ graphVersions u nId = do
                 . gm_list
                 . lfg_version
 
-  mcId <- getClosestParentIdByType nId NodeCorpus
+  mcId <- getClosestParentIdByType nId (Just NodeCorpus)
   let cId = maybe (panic "[G.V.G.API] Node has no parent") identity mcId
 
   listId <- getOrMkList cId u

src/Gargantext/Core/Viz/Phylo/API.hs

@@ -53,7 +53,7 @@ phyloAPI n = Named.PhyloAPI
 getPhylo :: IsGargServer err env m => PhyloId -> Named.GetPhylo (AsServerT m)
 getPhylo phyloId = Named.GetPhylo $ \lId _level _minSizeBranch -> do
   corpusId <- maybe (nodeLookupError $ NodeParentDoesNotExist phyloId) pure
-              =<< getClosestParentIdByType phyloId NodeCorpus
+              =<< getClosestParentIdByType phyloId (Just NodeCorpus)
   listId   <- case lId of
                 Nothing -> defaultList corpusId
                 Just ld -> pure ld
@@ -100,7 +100,7 @@ postPhylo phyloId = Named.PostPhylo $ \_lId -> do
     -- _vrs = Just ("1" :: Text)
     -- _sft = Just (Software "Gargantext" "4")
     -- _prm = initPhyloParam vrs sft (Just q)
-  corpusId <- getClosestParentIdByType phyloId NodeCorpus
+  corpusId <- getClosestParentIdByType phyloId (Just NodeCorpus)
   -- Being the first time we ask for the Phylo, there is no historical data
   -- available about computing time, so we pass 'Nothing'.
   phy <- flowPhyloAPI defaultConfig Nothing (fromMaybe (panicTrace "[G.C.V.P.API] no corpus ID found") corpusId) -- params

src/Gargantext/Database/Query/Table/Node.hs

@@ -44,7 +44,7 @@ module Gargantext.Database.Query.Table.Node
 
   -- * Queries that returns multiple nodes
   , getChildrenByType
-  , getClosestChildrenByType
+  , getDirectChildrenByType
   , getListsWithParentId
   , getNodesIdWithType
   , getNodesWith
@@ -73,6 +73,7 @@ import Control.Arrow (returnA)
 import Control.Lens (set, view)
 import Data.Aeson ( encode, Value )
 import Data.Bimap ((!>))
+import Data.List.NonEmpty qualified as NE
 import Database.PostgreSQL.Simple qualified as PGS
 import Database.PostgreSQL.Simple.SqlQQ (sql)
 import Gargantext.API.Errors.Types (BackendInternalError (..))
@@ -93,7 +94,6 @@ import Gargantext.Database.Schema.Node
 import Gargantext.Prelude hiding (sum, head)
 import Opaleye hiding (FromField)
 import Prelude hiding (null, id, map, sum)
-import qualified Data.List.NonEmpty as NE
 
 
 queryNodeSearchTable :: Select NodeSearchRead
@@ -170,7 +170,7 @@ getParentId :: NodeId -> DBCmd err (Maybe NodeId)
 getParentId nId = do
   result <- runPGSQuery query (PGS.Only nId)
   case result of
-    [PGS.Only parentId] -> pure $ Just $ UnsafeMkNodeId parentId
+    [PGS.Only (Just parentId)] -> pure $ Just $ UnsafeMkNodeId parentId
     _ -> pure Nothing
   where
     query :: PGS.Query
@@ -183,18 +183,20 @@ getParentId nId = do
 -- | Given a node id, find it's closest parent of given type
 -- NOTE: This isn't too optimal: can make successive queries depending on how
 -- deeply nested the child is.
+-- NOTE If given nodeType is Nothing, just get the first parent.
 getClosestParentIdByType :: HasDBid NodeType
                          => NodeId
-                         -> NodeType
+                         -> Maybe NodeType
                          -> DBCmd err (Maybe NodeId)
-getClosestParentIdByType nId nType = do
+getClosestParentIdByType nId Nothing = getParentId nId
+getClosestParentIdByType nId (Just nType) = do
   result <- runPGSQuery query (PGS.Only nId)
   case result of
     [(_NodeId -> parentId, pTypename)] -> do
       if toDBid nType == pTypename then
         pure $ Just $ UnsafeMkNodeId parentId
       else
-        getClosestParentIdByType (UnsafeMkNodeId parentId) nType
+        getClosestParentIdByType (UnsafeMkNodeId parentId) (Just nType)
     _ -> pure Nothing
   where
     query :: PGS.Query
@@ -209,16 +211,17 @@ getClosestParentIdByType nId nType = do
 -- in search too
 getClosestParentIdByType' :: HasDBid NodeType
                           => NodeId
-                          -> NodeType
+                          -> Maybe NodeType
                           -> DBCmd err (Maybe NodeId)
-getClosestParentIdByType' nId nType = do
+getClosestParentIdByType' nId Nothing = pure $ Just nId
+getClosestParentIdByType' nId (Just nType) = do
   result <- runPGSQuery query (PGS.Only nId)
   case result of
     [(_NodeId -> id, pTypename)] -> do
       if toDBid nType == pTypename then
         pure $ Just $ UnsafeMkNodeId id
       else
-        getClosestParentIdByType nId nType
+        getClosestParentIdByType nId (Just nType)
     _ -> pure Nothing
   where
     query :: PGS.Query
@@ -232,20 +235,31 @@ getClosestParentIdByType' nId nType = do
 -- given node type.
 getChildrenByType :: HasDBid NodeType
                   => NodeId
-                  -> NodeType
+                  -> Maybe NodeType
                   -> DBCmd err [NodeId]
 getChildrenByType nId nType = do
-  childrenFirstLevel <- getClosestChildrenByType nId nType
+  childrenFirstLevel <- getDirectChildrenByType nId nType
   childrenLst <- mapM (\id -> getChildrenByType id nType) childrenFirstLevel
   pure $ childrenFirstLevel ++ concat childrenLst
 
 -- | Given a node id, find all it's children (only first level) of
 -- given node type.
-getClosestChildrenByType :: HasDBid NodeType
-                         => NodeId
-                         -> NodeType
-                         -> DBCmd err [NodeId]
-getClosestChildrenByType nId nType = do
+-- If nodeType is Nothing, return all children.
+getDirectChildrenByType :: HasDBid NodeType
+                        => NodeId
+                        -> Maybe NodeType
+                        -> DBCmd err [NodeId]
+getDirectChildrenByType nId Nothing = do
+  results <- runPGSQuery query (PGS.Only nId)
+  pure $ (\(PGS.Only nodeId) -> nodeId) <$> results
+  where
+    query :: PGS.Query
+    query = [sql|
+      SELECT n.id
+      FROM nodes n
+      WHERE n.parent_id = ?
+    |]
+getDirectChildrenByType nId (Just nType) = do
   results <- runPGSQuery query (nId, toDBid nType)
   pure $ (\(PGS.Only nodeId) -> nodeId) <$> results
   where
@@ -350,9 +364,12 @@ insertDefaultNode :: (HasDBid NodeType, HasNodeError err)
 insertDefaultNode nt p u = insertNode nt Nothing Nothing p u
 
 insertDefaultNodeIfNotExists :: (HasDBid NodeType, HasNodeError err)
-                             => NodeType -> ParentId -> UserId -> DBCmd err [NodeId]
+                             => NodeType
+                             -> ParentId
+                             -> UserId
+                             -> DBCmd err [NodeId]
 insertDefaultNodeIfNotExists nt p u = do
-  children <- getChildrenByType p nt
+  children <- getChildrenByType p (Just nt)
   case children of
     [] -> (:[]) <$> insertDefaultNode nt p u
     xs -> pure xs

test/Test/API/GraphQL.hs

@@ -23,13 +23,13 @@ import Text.RawString.QQ (r)
 tests :: Spec
 tests = sequential $ aroundAll withTestDBAndPort $ beforeAllWith dbEnvSetup $ do
   describe "GraphQL" $ do
-    describe "get_user_infos" $ do
+    describe "userInfo" $ do
       it "allows 'alice' to see her own info" $ \SpecContext{..} -> do
         withApplication _sctx_app $ do
           withValidLoginA _sctx_port "alice" (GargPassword "alice") $ \_clientEnv authRes -> do
             liftIO $ (authRes ^. authRes_user_id) `shouldBe` (UnsafeMkUserId 2)
-            let query = [r| { "query": "{ user_infos(user_id: 2) { ui_id, ui_email } }" } |]
-            let expected = [json| {data: {user_infos: [{ui_id: 2, ui_email: "alice@gargan.text" }] } } |]
+            let query = [r| { "query": "{ userInfo(userId: 2) { ui_id, ui_email } }" } |]
+            let expected = [json| {data: {userInfo: {ui_id: 2, ui_email: "alice@gargan.text" } } } |]
             protected (authRes ^. authRes_token) "POST" "/gql" query `shouldRespondWithFragment` expected
 
     describe "get_users" $ do
@@ -38,16 +38,16 @@ tests = sequential $ aroundAll withTestDBAndPort $ beforeAllWith dbEnvSetup $ do
           withValidLoginA _sctx_port "alice" (GargPassword "alice") $ \_clientEnv authRes -> do
             -- epo_api_user is a renamed field, we check if it's correctly un-prefixed
             liftIO $ (authRes ^. authRes_tree_id) `shouldBe` 8
-            let query = [r| { "query": "{ users(user_id: 8) { u_username, u_hyperdata { epo_api_user, public { pseudo }, private { lang } } } }" } |]
-            let expected = [json| {data: {users: [{u_username: "alice", u_hyperdata: {epo_api_user: null, public: { pseudo: "pseudo" }, private: { lang: "EN" } } }] } } |]
+            let query = [r| { "query": "{ user(id: 8) { u_username, u_hyperdata { epo_api_user, public { pseudo }, private { lang } } } }" } |]
+            let expected = [json| {data: {user: {u_username: "alice", u_hyperdata: {epo_api_user: null, public: { pseudo: "pseudo" }, private: { lang: "EN" } } } } } |]
             protected (authRes ^. authRes_token) "POST" "/gql" query `shouldRespondWithFragment` expected
 
     describe "nodes" $ do
       it "returns node_type" $ \(SpecContext _testEnv port app _) -> do
         withApplication app $ do
           withValidLogin port "gargantua" (GargPassword "secret_key") $ \_clientEnv token -> do
-            let query = [r| { "query": "{ nodes(node_id: 2) { node_type } }" } |]
-            let expected = [json| {data: {nodes: [{node_type: "NodeFolderPrivate" }]}} |]
+            let query = [r| { "query": "{ node(id: 2) { node_type } }" } |]
+            let expected = [json| {data: {node: {node_type: "NodeFolderPrivate" }}} |]
             protected token "POST" "/gql" query `shouldRespondWithFragment` expected
 
     describe "check error format" $ do