Add public nodes SQL queries

It also adds tests for getUserRootPublicNode

gargantext.cabal

@@ -813,6 +813,7 @@ test-suite garg-test-tasty
       Test.Database.Operations
       Test.Database.Operations.DocumentSearch
       Test.Database.Operations.NodeStory
+      Test.Database.Operations.PublishNode
       Test.Database.Setup
       Test.Database.Types
       Test.Graph.Clustering
@@ -863,6 +864,7 @@ test-suite garg-test-hspec
       Test.Database.Operations
       Test.Database.Operations.DocumentSearch
       Test.Database.Operations.NodeStory
+      Test.Database.Operations.PublishNode
       Test.Database.Setup
       Test.Database.Types
       Test.Instances

src/Gargantext/API/Errors.hs

@@ -155,6 +155,8 @@ nodeErrorToFrontendError ne = case ne of
            -> mkFrontendErrShow $ FE_node_lookup_failed_username_not_found uname
          UserHasTooManyRoots uid roots
            -> mkFrontendErrShow $ FE_node_lookup_failed_user_too_many_roots uid roots
+         UserPublicFolderDoesNotExist uid
+           -> mkFrontendErrShow $ FE_node_lookup_failed_user_no_public_folder uid
   NotImplYet
     -> mkFrontendErrShow FE_node_not_implemented_yet
   NoContextFound contextId

src/Gargantext/API/Errors/Types.hs

@@ -215,6 +215,10 @@ data instance ToFrontendErrorData 'EC_400__node_lookup_failed_user_too_many_root
                                             }
   deriving (Show, Eq, Generic)
 
+data instance ToFrontendErrorData 'EC_404__node_lookup_failed_user_no_public_folder =
+  FE_node_lookup_failed_user_no_public_folder { nenpf_user_id :: UserId }
+  deriving (Show, Eq, Generic)
+
 newtype instance ToFrontendErrorData 'EC_404__node_context_not_found =
   FE_node_context_not_found { necnf_context_id :: ContextId }
   deriving (Show, Eq, Generic)
@@ -400,6 +404,14 @@ instance FromJSON (ToFrontendErrorData 'EC_400__node_lookup_failed_user_too_many
     netmr_roots   <- o .: "roots"
     pure FE_node_lookup_failed_user_too_many_roots{..}
 
+instance ToJSON (ToFrontendErrorData 'EC_404__node_lookup_failed_user_no_public_folder) where
+  toJSON (FE_node_lookup_failed_user_no_public_folder userId) =
+    object [ "user_id" .= toJSON userId ]
+instance FromJSON (ToFrontendErrorData 'EC_404__node_lookup_failed_user_no_public_folder) where
+  parseJSON = withObject "FE_node_lookup_failed_user_no_public_folder" $ \o -> do
+    nenpf_user_id <- o .: "user_id"
+    pure FE_node_lookup_failed_user_no_public_folder{..}
+
 instance ToJSON (ToFrontendErrorData 'EC_404__node_context_not_found) where
   toJSON (FE_node_context_not_found cId) = object [ "context_id" .= toJSON cId ]
 instance FromJSON (ToFrontendErrorData 'EC_404__node_context_not_found) where
@@ -616,6 +628,9 @@ instance FromJSON FrontendError where
       EC_400__node_lookup_failed_user_too_many_roots -> do
         (fe_data :: ToFrontendErrorData 'EC_400__node_lookup_failed_user_too_many_roots) <- o .: "data"
         pure FrontendError{..}
+      EC_404__node_lookup_failed_user_no_public_folder -> do
+        (fe_data :: ToFrontendErrorData 'EC_404__node_lookup_failed_user_no_public_folder) <- o .: "data"
+        pure FrontendError{..}
       EC_500__node_not_implemented_yet -> do
         (fe_data :: ToFrontendErrorData 'EC_500__node_not_implemented_yet) <- o .: "data"
         pure FrontendError{..}

src/Gargantext/API/Errors/Types/Backend.hs

@@ -23,6 +23,7 @@ data BackendErrorCode
   | EC_400__node_lookup_failed_user_too_many_roots
   | EC_404__node_lookup_failed_user_not_found
   | EC_404__node_lookup_failed_username_not_found
+  | EC_404__node_lookup_failed_user_no_public_folder
   | EC_404__node_corpus_not_found
   | EC_500__node_not_implemented_yet
   | EC_404__node_context_not_found

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

@@ -15,8 +15,46 @@ Portability : POSIX
 {-# LANGUAGE TypeFamilies           #-}
 {-# LANGUAGE ViewPatterns           #-}
 
+{-# OPTIONS_GHC -fno-warn-unused-binds #-}
+
 module Gargantext.Database.Query.Table.Node
-  where
+  ( -- * Smart constructors, classes, defaults and helper functions
+    defaultList
+  , MkCorpus(..)
+  , node
+  , queryNodeSearchTable
+
+  -- * Queries that returns a single node
+  , getClosestParentIdByType
+  , getClosestParentIdByType'
+  , getCorporaWithParentId
+  , getNode
+  , getNodeWith
+  , getNodeWithType
+  , getOrMkList
+  , getUserRootPublicNode
+  , selectNode
+
+  -- * Queries that returns multiple nodes
+  , getChildrenByType
+  , getClosestChildrenByType
+  , getListsWithParentId
+  , getNodesIdWithType
+  , getNodesWith
+  , getNodesWithParentId
+  , getNodesWithType
+
+  -- * Creating one or more nodes
+  , insertDefaultNode
+  , insertDefaultNodeIfNotExists
+  , insertNode
+  , insertNodesWithParentR
+
+  -- * Deleting one or more nodes
+  , deleteNode
+  , deleteNodes
+
+  ) where
 
 import Control.Arrow (returnA)
 import Control.Lens (set, view)
@@ -28,11 +66,12 @@ import Gargantext.Core.Types
 import Gargantext.Core.Types.Query (Limit, Offset)
 import Gargantext.Database.Admin.Types.Hyperdata.Any ( HyperdataAny )
 import Gargantext.Database.Admin.Types.Hyperdata.Corpus ( HyperdataAnnuaire, HyperdataCorpus )
+import Gargantext.Database.Admin.Types.Hyperdata.Default ( defaultHyperdata, DefaultHyperdata(..) )
 import Gargantext.Database.Admin.Types.Hyperdata.Document ( HyperdataDocument, HyperdataDocumentV3 )
+import Gargantext.Database.Admin.Types.Hyperdata.Folder (HyperdataFolder)
 import Gargantext.Database.Admin.Types.Hyperdata.List ( HyperdataList )
 import Gargantext.Database.Admin.Types.Hyperdata.Model ( HyperdataModel )
 import Gargantext.Database.Admin.Types.Hyperdata.Prelude ( Hyperdata )
-import Gargantext.Database.Admin.Types.Hyperdata.Default ( defaultHyperdata, DefaultHyperdata(..) )
 import Gargantext.Database.Prelude (DBCmd, JSONB, mkCmd, runPGSQuery, runOpaQuery)
 import Gargantext.Database.Query.Filter (limit', offset')
 import Gargantext.Database.Query.Table.Node.Error
@@ -442,3 +481,20 @@ defaultListMaybe cId = headMay <$> map (view node_id ) <$> getListsWithParentId
 
 getListsWithParentId :: HasDBid NodeType => NodeId -> DBCmd err [Node HyperdataList]
 getListsWithParentId n = runOpaQuery $ selectNodesWith' n (Just NodeList)
+
+-- | Returns the /root/ public node for the input user. By root we mean that
+-- if we were to traverse all the parents of the result, we wouldn't find any
+-- other parent which 'NodeType' was 'NodeFolderPublic'.
+getUserRootPublicNode :: (HasNodeError err, HasDBid NodeType)
+                      => UserId
+                      -> DBCmd err (Node HyperdataFolder)
+getUserRootPublicNode userId = do
+  result <- runOpaQuery $ do
+    n <- queryNodeTable
+    where_ $ (n ^. node_typename .== sqlInt4 (toDBid NodeFolderPublic)) .&&
+             (n ^. node_user_id  .== sqlInt4 (_UserId userId))
+    pure n
+  case result of
+    []      -> nodeError $ NodeLookupFailed $ UserPublicFolderDoesNotExist userId
+    [n]     -> pure n
+    folders -> nodeError $ NodeLookupFailed $ UserHasTooManyRoots userId (map _node_id folders)

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

@@ -57,6 +57,7 @@ data NodeLookupError
   | UserDoesNotExist     UserId
   | UserNameDoesNotExist Username
   | UserHasTooManyRoots UserId [NodeId]
+  | UserPublicFolderDoesNotExist UserId
   deriving (Show, Eq, Generic)
 
 instance ToJSON NodeLookupError
@@ -68,6 +69,7 @@ renderNodeLookupFailed = \case
   UserDoesNotExist uid -> "user with id " <> T.pack (show uid) <> " couldn't be found."
   UserNameDoesNotExist uname -> "user with username '" <> uname <> "' couldn't be found."
   UserHasTooManyRoots uid roots -> "user with id " <> T.pack (show uid) <> " has too many roots: [" <> T.intercalate "," (map (T.pack . show) roots)
+  UserPublicFolderDoesNotExist uid -> "no public folder was found for user with id " <> T.pack (show uid)
 
 ------------------------------------------------------------------------
 data NodeError = NoListFound ListId

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

@@ -26,20 +26,23 @@ module Gargantext.Database.Query.Table.NodeNode
   , selectDocNodes
   , selectDocs
   , selectDocsDates
+
+  -- Queries on public nodes
   , selectPublicNodes
+  , isNodeReadOnly
   )
   where
 
 import Control.Arrow (returnA)
 import Control.Lens (view)
-import Data.Text (splitOn)
 import Database.PostgreSQL.Simple qualified as PGS
 import Database.PostgreSQL.Simple.SqlQQ (sql)
 import Database.PostgreSQL.Simple.Types (Values(..), QualifiedIdentifier(..))
+import Data.Text (splitOn)
 import Gargantext.Core ( HasDBid(toDBid) )
-import Gargantext.Database.Admin.Types.Node
 import Gargantext.Database.Admin.Types.Hyperdata.Document ( HyperdataDocument, hd_publication_date )
 import Gargantext.Database.Admin.Types.Hyperdata.Prelude ( Hyperdata )
+import Gargantext.Database.Admin.Types.Node
 import Gargantext.Database.Prelude (DBCmd, mkCmd, runPGSQuery, runCountOpaQuery, runOpaQuery)
 import Gargantext.Database.Schema.Ngrams ()
 import Gargantext.Database.Schema.Node
@@ -227,10 +230,19 @@ joinInCorpus = proc () -> do
 
 
 ------------------------------------------------------------------------
+-- | Returns /all/ the public nodes, i.e. nodes which 'NodeType' is
+-- 'NodeFolderPublic'. Each user, upon creation, receives his/her personal
+-- public folder. Nodes placed inside /any/ public folder is visible into
+-- /any other/ public folder.
 selectPublicNodes :: HasDBid NodeType => (Hyperdata a, DefaultFromField SqlJsonb a)
                   => DBCmd err [(Node a, Maybe Int)]
 selectPublicNodes = runOpaQuery (queryWithType NodeFolderPublic)
 
+-- | A 'Node' is read-only if there exist a match in the node_nodes directory
+-- where the source is a public folder.
+isNodeReadOnly :: NodeId -> DBCmd err Bool
+isNodeReadOnly _ = panicTrace "todo isNodeReadOnly"
+
 queryWithType :: HasDBid NodeType
               => NodeType
               -> O.Select (NodeRead, MaybeFields (Column SqlInt4))

test/Test/API/Private/Share.hs

@@ -46,7 +46,7 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
     it "setup DB triggers" $ \((testEnv, _), _) -> do
       setupEnvironment testEnv
       -- Let's create the Alice user.
-      createAliceAndBob testEnv
+      void $ createAliceAndBob testEnv
 
     it "should fail if no node type is specified" $ \((_testEnv, serverPort), app) -> do
       withApplication app $ do

test/Test/API/Setup.hs

@@ -10,10 +10,10 @@ import Control.Monad.Reader
 import Data.ByteString.Lazy.Char8 qualified as C8L
 import Data.Cache qualified as InMemory
 import Data.Streaming.Network (bindPortTCP)
-import Gargantext.API (makeApp)
 import Gargantext.API.Admin.EnvTypes (Mode(Mock), Env (..))
 import Gargantext.API.Admin.Settings
 import Gargantext.API.Errors.Types
+import Gargantext.API (makeApp)
 import Gargantext.API.Prelude
 import Gargantext.Core.Config (_gc_secrets, gc_frontend_config, gc_jobs, hasConfig)
 import Gargantext.Core.Config.Types (SettingsFile(..), jc_js_job_timeout, jc_js_id_timeout, fc_appPort, jwtSettings)
@@ -25,22 +25,23 @@ import Gargantext.Database.Action.User.New
 import Gargantext.Database.Admin.Config (userMaster)
 import Gargantext.Database.Admin.Trigger.Init
 import Gargantext.Database.Admin.Types.Hyperdata
+import Gargantext.Database.Admin.Types.Node
 import Gargantext.Database.Prelude ()
 import Gargantext.Database.Query.Table.Node (getOrMkList)
 import Gargantext.Database.Query.Tree.Root (MkCorpusUser(..))
 import Gargantext.MicroServices.ReverseProxy (microServicesProxyApp)
 import Gargantext.System.Logging
-import Gargantext.Utils.Jobs qualified as Jobs
 import Gargantext.Utils.Jobs.Monad qualified as Jobs
+import Gargantext.Utils.Jobs qualified as Jobs
 import Gargantext.Utils.Jobs.Queue qualified as Jobs
 import Gargantext.Utils.Jobs.Settings qualified as Jobs
 import Network.HTTP.Client.TLS (newTlsManager)
 import Network.HTTP.Types
 import Network.Wai (Application, responseLBS)
-import Network.Wai qualified as Wai
-import Network.Wai.Handler.Warp (runSettingsSocket)
-import Network.Wai.Handler.Warp qualified as Warp
 import Network.Wai.Handler.Warp.Internal
+import Network.Wai.Handler.Warp qualified as Warp
+import Network.Wai.Handler.Warp (runSettingsSocket)
+import Network.Wai qualified as Wai
 import Prelude
 import Servant.Auth.Client ()
 import Servant.Client
@@ -155,14 +156,15 @@ setupEnvironment env = flip runReaderT env $ runTestMonad $ do
 
 -- | Creates two users, Alice & Bob. Alice shouldn't be able to see
 -- Bob's private data and vice-versa.
-createAliceAndBob :: TestEnv -> IO ()
+createAliceAndBob :: TestEnv -> IO [UserId]
 createAliceAndBob testEnv = do
-  void $ flip runReaderT testEnv $ runTestMonad $ do
+  flip runReaderT testEnv $ runTestMonad $ do
     let nur1 = mkNewUser "alice@gargan.text" (GargPassword "alice")
     let nur2 = mkNewUser "bob@gargan.text" (GargPassword "bob")
 
-    void $ new_user nur1
-    void $ new_user nur2
+    aliceId <- new_user nur1
+    bobId   <- new_user nur2
+    pure [aliceId, bobId]
 
 -- show the full exceptions during testing, rather than shallowing them under a generic
 -- "Something went wrong".

test/Test/API/UpdateList.hs

@@ -116,7 +116,7 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
   describe "UpdateList API" $ do
     it "setup DB triggers and users" $ \((testEnv, _), _) -> do
       setupEnvironment testEnv
-      createAliceAndBob testEnv
+      void $ createAliceAndBob testEnv
 
     describe "POST /api/v1.0/lists/:id/add/form/async (JSON)" $ do
 

test/Test/Database/Operations.hs

@@ -30,6 +30,7 @@ import Gargantext.Prelude
 import Test.API.Setup (setupEnvironment)
 import Test.Database.Operations.DocumentSearch
 import Test.Database.Operations.NodeStory
+import Test.Database.Operations.PublishNode
 import Test.Database.Setup (withTestDB)
 import Test.Database.Types
 import Test.Hspec
@@ -68,6 +69,8 @@ tests = sequential $ aroundAll withTestDB $ describe "Database" $ do
       it "Can perform more complex searches using the boolean API" corpusSearch03
       it "Can correctly count doc score" corpusScore01
       it "Can perform search with spaces for doc in db" corpusSearchDB01
+    describe "Publishing a node" $ do
+      it "Returns the root public folder for a user" testGetUserRootPublicNode
 
 nodeStoryTests :: Spec
 nodeStoryTests = sequential $

test/Test/Database/Operations/PublishNode.hs

+{-|
+Module      : Test.Database.Operations.PublishNode
+Description : GarganText database tests
+Copyright   : (c) CNRS, 2017-Present
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+-}
+
+{-# LANGUAGE QuasiQuotes       #-}
+
+module Test.Database.Operations.PublishNode where
+
+import Prelude
+
+import Control.Monad.Reader
+import Gargantext.Core
+import Gargantext.Database.Admin.Types.Node
+import Gargantext.Database.Query.Table.Node
+import Gargantext.Database.Schema.Node (NodePoly(..))
+
+import Test.API.Setup (createAliceAndBob)
+import Test.Database.Types
+import Test.Tasty.HUnit
+
+testGetUserRootPublicNode :: TestEnv -> Assertion
+testGetUserRootPublicNode testEnv = do
+  [aliceId, _bobId] <- createAliceAndBob testEnv
+  alicePublicFolder <- flip runReaderT testEnv $ runTestMonad $ do
+    getUserRootPublicNode aliceId
+  _node_typename alicePublicFolder @?= (toDBid NodeFolderPublic)

test/Test/Instances.hs

@@ -266,6 +266,9 @@ genFrontendErr be = do
       -> do userId <- arbitrary
             roots  <- arbitrary
             pure $ Errors.mkFrontendErr' txt (Errors.FE_node_lookup_failed_user_too_many_roots userId roots)
+    Errors.EC_404__node_lookup_failed_user_no_public_folder
+      -> do userId <- arbitrary
+            pure $ Errors.mkFrontendErr' txt (Errors.FE_node_lookup_failed_user_no_public_folder userId)
     Errors.EC_404__node_context_not_found
       -> do contextId <- arbitrary
             pure $ Errors.mkFrontendErr' txt (Errors.FE_node_context_not_found contextId)

test/Test/Server/ReverseProxy.hs

 
 module Test.Server.ReverseProxy where
 
+import Control.Monad (void)
 import Data.Function ((&))
 import Gargantext.MicroServices.ReverseProxy
 import Network.HTTP.Client
@@ -52,7 +53,7 @@ writeFrameTests = sequential $ aroundAll withBackendServerAndProxy $ do
 
     it "should allow authenticated requests" $ \(testEnv, serverPort, proxyPort) -> do
       -- Let's create the Alice user.
-      createAliceAndBob testEnv
+      void $ createAliceAndBob testEnv
       baseUrl <- parseBaseUrl "http://localhost"
       manager <- newManager defaultManagerSettings
       let clientEnv prt = mkClientEnv manager (baseUrl { baseUrlPort = prt })

test/drivers/hspec/Main.hs

@@ -8,7 +8,6 @@ import Control.Monad
 import Data.Text (isInfixOf)
 import Gargantext.Core.AsyncUpdates.CentralExchange qualified as CE
 import Gargantext.Core.AsyncUpdates.Dispatcher qualified as D
-import Gargantext.Core.AsyncUpdates.Dispatcher.Types qualified as DT
 import Gargantext.Core.Config.Types (NotificationsConfig(..))
 import Shelly hiding (FilePath)
 import System.IO
@@ -82,11 +81,10 @@ main = do
   hSetBuffering stdout NoBuffering
   -- TODO Ideally remove start/stop notifications and use
   -- Test/API/Setup to initialize this in env
-  withNotifications $ \(nc, _, _) -> do
+  withNotifications $ \(ncfg, _, _) -> do
     bracket startCoreNLPServer stopCoreNLPServer $ \_ -> hspec $ do
-      API.tests nc
+      API.tests ncfg
       ReverseProxy.tests
       DB.tests
       DB.nodeStoryTests
       runIO $ putText "tests finished"
-