Commit ab0a0edf authored by Alfredo Di Napoli's avatar Alfredo Di Napoli

Split NodeAPIEndpoint

This commit splits the old `NodeAPIEndpoint` type into three;

* `NodeAPIEndpoint`, which will also contain the freeze endpoint;
* `AnnuaireAPIEndpoint`, which is the plain old node API without extra
  features;
* `CorpusAPIEndpoint`, which will also contain the publishin endpoint.

This split ensures that we don't add endpoints which do not belong to
all three categories, like before.

Furthermore this adds a public nodes SQL queries.
It also adds tests for getUserRootPublicNode
parent 0bbbba60
...@@ -816,6 +816,7 @@ test-suite garg-test-tasty ...@@ -816,6 +816,7 @@ test-suite garg-test-tasty
Test.Database.Operations Test.Database.Operations
Test.Database.Operations.DocumentSearch Test.Database.Operations.DocumentSearch
Test.Database.Operations.NodeStory Test.Database.Operations.NodeStory
Test.Database.Operations.PublishNode
Test.Database.Setup Test.Database.Setup
Test.Database.Types Test.Database.Types
Test.Graph.Clustering Test.Graph.Clustering
...@@ -868,6 +869,7 @@ test-suite garg-test-hspec ...@@ -868,6 +869,7 @@ test-suite garg-test-hspec
Test.Database.Operations Test.Database.Operations
Test.Database.Operations.DocumentSearch Test.Database.Operations.DocumentSearch
Test.Database.Operations.NodeStory Test.Database.Operations.NodeStory
Test.Database.Operations.PublishNode
Test.Database.Setup Test.Database.Setup
Test.Database.Types Test.Database.Types
Test.Instances Test.Instances
......
...@@ -155,6 +155,8 @@ nodeErrorToFrontendError ne = case ne of ...@@ -155,6 +155,8 @@ nodeErrorToFrontendError ne = case ne of
-> mkFrontendErrShow $ FE_node_lookup_failed_username_not_found uname -> mkFrontendErrShow $ FE_node_lookup_failed_username_not_found uname
UserHasTooManyRoots uid roots UserHasTooManyRoots uid roots
-> mkFrontendErrShow $ FE_node_lookup_failed_user_too_many_roots 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 NotImplYet
-> mkFrontendErrShow FE_node_not_implemented_yet -> mkFrontendErrShow FE_node_not_implemented_yet
NoContextFound contextId NoContextFound contextId
......
...@@ -215,6 +215,10 @@ data instance ToFrontendErrorData 'EC_400__node_lookup_failed_user_too_many_root ...@@ -215,6 +215,10 @@ data instance ToFrontendErrorData 'EC_400__node_lookup_failed_user_too_many_root
} }
deriving (Show, Eq, Generic) 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 = newtype instance ToFrontendErrorData 'EC_404__node_context_not_found =
FE_node_context_not_found { necnf_context_id :: ContextId } FE_node_context_not_found { necnf_context_id :: ContextId }
deriving (Show, Eq, Generic) deriving (Show, Eq, Generic)
...@@ -400,6 +404,14 @@ instance FromJSON (ToFrontendErrorData 'EC_400__node_lookup_failed_user_too_many ...@@ -400,6 +404,14 @@ instance FromJSON (ToFrontendErrorData 'EC_400__node_lookup_failed_user_too_many
netmr_roots <- o .: "roots" netmr_roots <- o .: "roots"
pure FE_node_lookup_failed_user_too_many_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 instance ToJSON (ToFrontendErrorData 'EC_404__node_context_not_found) where
toJSON (FE_node_context_not_found cId) = object [ "context_id" .= toJSON cId ] toJSON (FE_node_context_not_found cId) = object [ "context_id" .= toJSON cId ]
instance FromJSON (ToFrontendErrorData 'EC_404__node_context_not_found) where instance FromJSON (ToFrontendErrorData 'EC_404__node_context_not_found) where
...@@ -616,6 +628,9 @@ instance FromJSON FrontendError where ...@@ -616,6 +628,9 @@ instance FromJSON FrontendError where
EC_400__node_lookup_failed_user_too_many_roots -> do EC_400__node_lookup_failed_user_too_many_roots -> do
(fe_data :: ToFrontendErrorData 'EC_400__node_lookup_failed_user_too_many_roots) <- o .: "data" (fe_data :: ToFrontendErrorData 'EC_400__node_lookup_failed_user_too_many_roots) <- o .: "data"
pure FrontendError{..} 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 EC_500__node_not_implemented_yet -> do
(fe_data :: ToFrontendErrorData 'EC_500__node_not_implemented_yet) <- o .: "data" (fe_data :: ToFrontendErrorData 'EC_500__node_not_implemented_yet) <- o .: "data"
pure FrontendError{..} pure FrontendError{..}
......
...@@ -23,6 +23,7 @@ data BackendErrorCode ...@@ -23,6 +23,7 @@ data BackendErrorCode
| EC_400__node_lookup_failed_user_too_many_roots | EC_400__node_lookup_failed_user_too_many_roots
| EC_404__node_lookup_failed_user_not_found | EC_404__node_lookup_failed_user_not_found
| EC_404__node_lookup_failed_username_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_404__node_corpus_not_found
| EC_500__node_not_implemented_yet | EC_500__node_not_implemented_yet
| EC_404__node_context_not_found | EC_404__node_context_not_found
......
...@@ -200,22 +200,22 @@ moveNode _u n p = update (Move n p) ...@@ -200,22 +200,22 @@ moveNode _u n p = update (Move n p)
------------------------------------------------------------- -------------------------------------------------------------
annuaireNodeAPI :: AuthenticatedUser annuaireNodeAPI :: AuthenticatedUser
-> Named.NodeAPIEndpoint HyperdataAnnuaire (AsServerT (GargM Env BackendInternalError)) -> Named.AnnuaireAPIEndpoint (AsServerT (GargM Env BackendInternalError))
annuaireNodeAPI authenticatedUser = Named.NodeAPIEndpoint $ \targetNode -> annuaireNodeAPI authenticatedUser = Named.AnnuaireAPIEndpoint $ \targetNode ->
withNamedAccess authenticatedUser (PathNode targetNode) (concreteAPI targetNode) withNamedAccess authenticatedUser (PathNode targetNode) (concreteAPI targetNode)
where where
concreteAPI = genericNodeAPI' (Proxy :: Proxy HyperdataAnnuaire) authenticatedUser concreteAPI = genericNodeAPI' (Proxy :: Proxy HyperdataAnnuaire) authenticatedUser
corpusNodeAPI :: AuthenticatedUser corpusNodeAPI :: AuthenticatedUser
-> Named.NodeAPIEndpoint HyperdataCorpus (AsServerT (GargM Env BackendInternalError)) -> Named.CorpusAPIEndpoint (AsServerT (GargM Env BackendInternalError))
corpusNodeAPI authenticatedUser = Named.NodeAPIEndpoint $ \targetNode -> corpusNodeAPI authenticatedUser = Named.CorpusAPIEndpoint $ \targetNode ->
withNamedAccess authenticatedUser (PathNode targetNode) (concreteAPI targetNode) withNamedAccess authenticatedUser (PathNode targetNode) (concreteAPI targetNode)
where where
concreteAPI = genericNodeAPI' (Proxy :: Proxy HyperdataCorpus) authenticatedUser concreteAPI = genericNodeAPI' (Proxy :: Proxy HyperdataCorpus) authenticatedUser
------------------------------------------------------------------------ ------------------------------------------------------------------------
nodeAPI :: AuthenticatedUser nodeAPI :: AuthenticatedUser
-> Named.NodeAPIEndpoint HyperdataAny (AsServerT (GargM Env BackendInternalError)) -> Named.NodeAPIEndpoint (AsServerT (GargM Env BackendInternalError))
nodeAPI authenticatedUser = Named.NodeAPIEndpoint $ \targetNode -> nodeAPI authenticatedUser = Named.NodeAPIEndpoint $ \targetNode ->
withNamedAccess authenticatedUser (PathNode targetNode) (concreteAPI targetNode) withNamedAccess authenticatedUser (PathNode targetNode) (concreteAPI targetNode)
where where
......
...@@ -11,14 +11,13 @@ module Gargantext.API.Routes.Named.Private ( ...@@ -11,14 +11,13 @@ module Gargantext.API.Routes.Named.Private (
, GargAdminAPI(..) , GargAdminAPI(..)
, NodeAPIEndpoint(..) , NodeAPIEndpoint(..)
, MembersAPI(..) , MembersAPI(..)
, IsGenericNodeRoute(..) , AnnuaireAPIEndpoint(..)
, CorpusAPIEndpoint(..)
) where ) where
import Data.Kind
import Data.Text (Text) import Data.Text (Text)
import GHC.Generics import GHC.Generics
import GHC.TypeLits
import Gargantext.API.Admin.Auth.Types import Gargantext.API.Admin.Auth.Types
import Gargantext.API.Auth.PolicyCheck import Gargantext.API.Auth.PolicyCheck
import Gargantext.API.Routes.Named.Contact import Gargantext.API.Routes.Named.Contact
...@@ -49,11 +48,11 @@ newtype GargPrivateAPI mode = GargPrivateAPI ...@@ -49,11 +48,11 @@ newtype GargPrivateAPI mode = GargPrivateAPI
data GargPrivateAPI' mode = GargPrivateAPI' data GargPrivateAPI' mode = GargPrivateAPI'
{ gargAdminAPI :: mode :- NamedRoutes GargAdminAPI { gargAdminAPI :: mode :- NamedRoutes GargAdminAPI
, nodeEp :: mode :- NamedRoutes (NodeAPIEndpoint HyperdataAny) , nodeEp :: mode :- NamedRoutes NodeAPIEndpoint
, contextEp :: mode :- "context" :> Summary "Context endpoint" , contextEp :: mode :- "context" :> Summary "Context endpoint"
:> Capture "node_id" ContextId :> Capture "node_id" ContextId
:> NamedRoutes (ContextAPI HyperdataAny) :> NamedRoutes (ContextAPI HyperdataAny)
, corpusNodeAPI :: mode :- NamedRoutes (NodeAPIEndpoint HyperdataCorpus) , corpusNodeAPI :: mode :- NamedRoutes CorpusAPIEndpoint
, corpusNodeNodeAPI :: mode :- "corpus" :> Summary "Corpus endpoint" , corpusNodeNodeAPI :: mode :- "corpus" :> Summary "Corpus endpoint"
:> Capture "node1_id" NodeId :> Capture "node1_id" NodeId
:> "document" :> "document"
...@@ -61,7 +60,7 @@ data GargPrivateAPI' mode = GargPrivateAPI' ...@@ -61,7 +60,7 @@ data GargPrivateAPI' mode = GargPrivateAPI'
:> NamedRoutes (NodeNodeAPI HyperdataAny) :> NamedRoutes (NodeNodeAPI HyperdataAny)
, corpusExportAPI :: mode :- "corpus" :> Capture "node_id" CorpusId , corpusExportAPI :: mode :- "corpus" :> Capture "node_id" CorpusId
:> NamedRoutes CorpusExportAPI :> NamedRoutes CorpusExportAPI
, annuaireEp :: mode :- NamedRoutes (NodeAPIEndpoint HyperdataAnnuaire) , annuaireEp :: mode :- NamedRoutes AnnuaireAPIEndpoint
, contactAPI :: mode :- "annuaire" :> Summary "Contact endpoint" , contactAPI :: mode :- "annuaire" :> Summary "Contact endpoint"
:> Capture "annuaire_id" NodeId :> Capture "annuaire_id" NodeId
:> NamedRoutes ContactAPI :> NamedRoutes ContactAPI
...@@ -102,31 +101,29 @@ data GargAdminAPI mode = GargAdminAPI ...@@ -102,31 +101,29 @@ data GargAdminAPI mode = GargAdminAPI
:> NamedRoutes NodesAPI :> NamedRoutes NodesAPI
} deriving Generic } deriving Generic
class IsGenericNodeRoute a where -- | The 'Node' API, unlike the ones for annuaire and corpus,
type family TyToSubPath (a :: Type) :: Symbol -- have other endpoints which should not be shared in the hierarchy,
type family TyToCapture (a :: Type) :: Symbol -- like the /freeze/ one. Similarly, a 'Corpus' API will have a
type family TyToSummary (a :: Type) :: Type -- '/publish' endpoint that doesn't generalise to everything.
data NodeAPIEndpoint mode = NodeAPIEndpoint
instance IsGenericNodeRoute HyperdataAny where { nodeEndpointAPI :: mode :- "node"
type instance TyToSubPath HyperdataAny = "node" :> Summary "Node endpoint"
type instance TyToCapture HyperdataAny = "node_id" :> Capture "node_id" NodeId
type instance TyToSummary HyperdataAny = Summary "Node endpoint" :> NamedRoutes (NodeAPI HyperdataAny)
} deriving Generic
instance IsGenericNodeRoute HyperdataCorpus where
type instance TyToSubPath HyperdataCorpus = "corpus" newtype AnnuaireAPIEndpoint mode = AnnuaireAPIEndpoint
type instance TyToCapture HyperdataCorpus = "corpus_id" { annuaireEndpointAPI :: mode :- "annuaire"
type instance TyToSummary HyperdataCorpus = Summary "Corpus endpoint" :> Summary "Annuaire endpoint"
:> Capture "annuaire_id" NodeId
instance IsGenericNodeRoute HyperdataAnnuaire where :> NamedRoutes (NodeAPI HyperdataAnnuaire)
type instance TyToSubPath HyperdataAnnuaire = "annuaire" } deriving Generic
type instance TyToCapture HyperdataAnnuaire = "annuaire_id"
type instance TyToSummary HyperdataAnnuaire = Summary "Annuaire endpoint" newtype CorpusAPIEndpoint mode = CorpusAPIEndpoint
{ corpusEndpointAPI :: mode :- "corpus"
newtype NodeAPIEndpoint a mode = NodeAPIEndpoint :> Summary "Corpus endpoint"
{ nodeEndpointAPI :: mode :- TyToSubPath a :> Capture "corpus_id" NodeId
:> TyToSummary a :> NamedRoutes (NodeAPI HyperdataCorpus)
:> Capture (TyToCapture a) NodeId
:> NamedRoutes (NodeAPI a)
} deriving Generic } deriving Generic
newtype MembersAPI mode = MembersAPI newtype MembersAPI mode = MembersAPI
......
...@@ -15,8 +15,47 @@ Portability : POSIX ...@@ -15,8 +15,47 @@ Portability : POSIX
{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ViewPatterns #-} {-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -fno-warn-unused-binds #-}
module Gargantext.Database.Query.Table.Node 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
, getParentId
, 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.Arrow (returnA)
import Control.Lens (set, view) import Control.Lens (set, view)
...@@ -28,11 +67,12 @@ import Gargantext.Core.Types ...@@ -28,11 +67,12 @@ import Gargantext.Core.Types
import Gargantext.Core.Types.Query (Limit, Offset) import Gargantext.Core.Types.Query (Limit, Offset)
import Gargantext.Database.Admin.Types.Hyperdata.Any ( HyperdataAny ) import Gargantext.Database.Admin.Types.Hyperdata.Any ( HyperdataAny )
import Gargantext.Database.Admin.Types.Hyperdata.Corpus ( HyperdataAnnuaire, HyperdataCorpus ) 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.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.List ( HyperdataList )
import Gargantext.Database.Admin.Types.Hyperdata.Model ( HyperdataModel ) import Gargantext.Database.Admin.Types.Hyperdata.Model ( HyperdataModel )
import Gargantext.Database.Admin.Types.Hyperdata.Prelude ( Hyperdata ) 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.Prelude (DBCmd, JSONB, mkCmd, runPGSQuery, runOpaQuery)
import Gargantext.Database.Query.Filter (limit', offset') import Gargantext.Database.Query.Filter (limit', offset')
import Gargantext.Database.Query.Table.Node.Error import Gargantext.Database.Query.Table.Node.Error
...@@ -442,3 +482,20 @@ defaultListMaybe cId = headMay <$> map (view node_id ) <$> getListsWithParentId ...@@ -442,3 +482,20 @@ defaultListMaybe cId = headMay <$> map (view node_id ) <$> getListsWithParentId
getListsWithParentId :: HasDBid NodeType => NodeId -> DBCmd err [Node HyperdataList] getListsWithParentId :: HasDBid NodeType => NodeId -> DBCmd err [Node HyperdataList]
getListsWithParentId n = runOpaQuery $ selectNodesWith' n (Just NodeList) 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)
...@@ -57,6 +57,7 @@ data NodeLookupError ...@@ -57,6 +57,7 @@ data NodeLookupError
| UserDoesNotExist UserId | UserDoesNotExist UserId
| UserNameDoesNotExist Username | UserNameDoesNotExist Username
| UserHasTooManyRoots UserId [NodeId] | UserHasTooManyRoots UserId [NodeId]
| UserPublicFolderDoesNotExist UserId
deriving (Show, Eq, Generic) deriving (Show, Eq, Generic)
instance ToJSON NodeLookupError instance ToJSON NodeLookupError
...@@ -68,6 +69,7 @@ renderNodeLookupFailed = \case ...@@ -68,6 +69,7 @@ renderNodeLookupFailed = \case
UserDoesNotExist uid -> "user with id " <> T.pack (show uid) <> " couldn't be found." UserDoesNotExist uid -> "user with id " <> T.pack (show uid) <> " couldn't be found."
UserNameDoesNotExist uname -> "user with username '" <> uname <> "' 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) 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 data NodeError = NoListFound ListId
......
...@@ -26,20 +26,23 @@ module Gargantext.Database.Query.Table.NodeNode ...@@ -26,20 +26,23 @@ module Gargantext.Database.Query.Table.NodeNode
, selectDocNodes , selectDocNodes
, selectDocs , selectDocs
, selectDocsDates , selectDocsDates
-- Queries on public nodes
, selectPublicNodes , selectPublicNodes
, isNodeReadOnly
) )
where where
import Control.Arrow (returnA) import Control.Arrow (returnA)
import Control.Lens (view) import Control.Lens (view)
import Data.Text (splitOn)
import Database.PostgreSQL.Simple qualified as PGS import Database.PostgreSQL.Simple qualified as PGS
import Database.PostgreSQL.Simple.SqlQQ (sql) import Database.PostgreSQL.Simple.SqlQQ (sql)
import Database.PostgreSQL.Simple.Types (Values(..), QualifiedIdentifier(..)) import Database.PostgreSQL.Simple.Types (Values(..), QualifiedIdentifier(..))
import Data.Text (splitOn)
import Gargantext.Core ( HasDBid(toDBid) ) 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.Document ( HyperdataDocument, hd_publication_date )
import Gargantext.Database.Admin.Types.Hyperdata.Prelude ( Hyperdata ) 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.Prelude (DBCmd, mkCmd, runPGSQuery, runCountOpaQuery, runOpaQuery)
import Gargantext.Database.Schema.Ngrams () import Gargantext.Database.Schema.Ngrams ()
import Gargantext.Database.Schema.Node import Gargantext.Database.Schema.Node
...@@ -227,10 +230,19 @@ joinInCorpus = proc () -> do ...@@ -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) selectPublicNodes :: HasDBid NodeType => (Hyperdata a, DefaultFromField SqlJsonb a)
=> DBCmd err [(Node a, Maybe Int)] => DBCmd err [(Node a, Maybe Int)]
selectPublicNodes = runOpaQuery (queryWithType NodeFolderPublic) 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 queryWithType :: HasDBid NodeType
=> NodeType => NodeType
-> O.Select (NodeRead, MaybeFields (Column SqlInt4)) -> O.Select (NodeRead, MaybeFields (Column SqlInt4))
......
...@@ -46,7 +46,7 @@ tests = sequential $ aroundAll withTestDBAndPort $ do ...@@ -46,7 +46,7 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
it "setup DB triggers" $ \SpecContext{..} -> do it "setup DB triggers" $ \SpecContext{..} -> do
setupEnvironment _sctx_env setupEnvironment _sctx_env
-- Let's create the Alice user. -- Let's create the Alice user.
createAliceAndBob _sctx_env void $ createAliceAndBob _sctx_env
it "should fail if no node type is specified" $ \(SpecContext _testEnv serverPort app _) -> do it "should fail if no node type is specified" $ \(SpecContext _testEnv serverPort app _) -> do
withApplication app $ do withApplication app $ do
......
...@@ -34,23 +34,24 @@ import Gargantext.Database.Action.User.New ...@@ -34,23 +34,24 @@ import Gargantext.Database.Action.User.New
import Gargantext.Database.Admin.Config (userMaster) import Gargantext.Database.Admin.Config (userMaster)
import Gargantext.Database.Admin.Trigger.Init import Gargantext.Database.Admin.Trigger.Init
import Gargantext.Database.Admin.Types.Hyperdata import Gargantext.Database.Admin.Types.Hyperdata
import Gargantext.Database.Admin.Types.Node
import Gargantext.Database.Prelude () import Gargantext.Database.Prelude ()
import Gargantext.Database.Query.Table.Node (getOrMkList) import Gargantext.Database.Query.Table.Node (getOrMkList)
import Gargantext.Database.Query.Tree.Root (MkCorpusUser(..)) import Gargantext.Database.Query.Tree.Root (MkCorpusUser(..))
import Gargantext.MicroServices.ReverseProxy (microServicesProxyApp) import Gargantext.MicroServices.ReverseProxy (microServicesProxyApp)
import Gargantext.System.Logging import Gargantext.System.Logging
import Gargantext.Utils.Jobs qualified as Jobs
import Gargantext.Utils.Jobs.Monad 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.Queue qualified as Jobs
import Gargantext.Utils.Jobs.Settings qualified as Jobs import Gargantext.Utils.Jobs.Settings qualified as Jobs
import Network.HTTP.Client.TLS (newTlsManager) import Network.HTTP.Client.TLS (newTlsManager)
import Network.HTTP.Types import Network.HTTP.Types
import Network.Wai (Application, responseLBS) 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.Internal
import Network.WebSockets qualified as WS import Network.WebSockets qualified as WS
import Network.Wai.Handler.Warp qualified as Warp
import Network.Wai.Handler.Warp (runSettingsSocket)
import Network.Wai qualified as Wai
import Prelude import Prelude
import Servant.Auth.Client () import Servant.Auth.Client ()
import Servant.Client import Servant.Client
...@@ -204,14 +205,15 @@ setupEnvironment env = flip runReaderT env $ runTestMonad $ do ...@@ -204,14 +205,15 @@ setupEnvironment env = flip runReaderT env $ runTestMonad $ do
-- | Creates two users, Alice & Bob. Alice shouldn't be able to see -- | Creates two users, Alice & Bob. Alice shouldn't be able to see
-- Bob's private data and vice-versa. -- Bob's private data and vice-versa.
createAliceAndBob :: TestEnv -> IO () createAliceAndBob :: TestEnv -> IO [UserId]
createAliceAndBob testEnv = do createAliceAndBob testEnv = do
void $ flip runReaderT testEnv $ runTestMonad $ do flip runReaderT testEnv $ runTestMonad $ do
let nur1 = mkNewUser "alice@gargan.text" (GargPassword "alice") let nur1 = mkNewUser "alice@gargan.text" (GargPassword "alice")
let nur2 = mkNewUser "bob@gargan.text" (GargPassword "bob") let nur2 = mkNewUser "bob@gargan.text" (GargPassword "bob")
void $ new_user nur1 aliceId <- new_user nur1
void $ new_user nur2 bobId <- new_user nur2
pure [aliceId, bobId]
-- show the full exceptions during testing, rather than shallowing them under a generic -- show the full exceptions during testing, rather than shallowing them under a generic
-- "Something went wrong". -- "Something went wrong".
......
...@@ -119,7 +119,7 @@ tests = sequential $ aroundAll withTestDBAndPort $ do ...@@ -119,7 +119,7 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
describe "UpdateList API" $ do describe "UpdateList API" $ do
it "setup DB triggers and users" $ \(SpecContext testEnv _port _app _) -> do it "setup DB triggers and users" $ \(SpecContext testEnv _port _app _) -> do
setupEnvironment testEnv setupEnvironment testEnv
createAliceAndBob testEnv void $ createAliceAndBob testEnv
describe "POST /api/v1.0/lists/:id/add/form/async (JSON)" $ do describe "POST /api/v1.0/lists/:id/add/form/async (JSON)" $ do
......
...@@ -30,6 +30,7 @@ import Gargantext.Prelude ...@@ -30,6 +30,7 @@ import Gargantext.Prelude
import Test.API.Setup (setupEnvironment) import Test.API.Setup (setupEnvironment)
import Test.Database.Operations.DocumentSearch import Test.Database.Operations.DocumentSearch
import Test.Database.Operations.NodeStory import Test.Database.Operations.NodeStory
import Test.Database.Operations.PublishNode
import Test.Database.Setup (withTestDB) import Test.Database.Setup (withTestDB)
import Test.Database.Types import Test.Database.Types
import Test.Hspec import Test.Hspec
...@@ -68,7 +69,9 @@ tests = sequential $ aroundAll withTestDB $ describe "Database" $ do ...@@ -68,7 +69,9 @@ tests = sequential $ aroundAll withTestDB $ describe "Database" $ do
it "Can perform more complex searches using the boolean API" corpusSearch03 it "Can perform more complex searches using the boolean API" corpusSearch03
it "Can correctly count doc score" corpusScore01 it "Can correctly count doc score" corpusScore01
it "Can perform search with spaces for doc in db" corpusSearchDB01 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 :: Spec
nodeStoryTests = sequential $ nodeStoryTests = sequential $
-- run 'withTestDB' before _every_ test item -- run 'withTestDB' before _every_ test item
......
{-|
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)
...@@ -16,8 +16,8 @@ module Test.Instances ...@@ -16,8 +16,8 @@ module Test.Instances
where where
import Data.List.NonEmpty qualified as NE import Data.List.NonEmpty qualified as NE
import Data.Map.Strict qualified as Map
import Data.Map.Strict.Patch qualified as PM import Data.Map.Strict.Patch qualified as PM
import Data.Map.Strict qualified as Map
import Data.Patch.Class (Replace(Keep), replace) import Data.Patch.Class (Replace(Keep), replace)
import Data.Text qualified as T import Data.Text qualified as T
import Data.Validity (Validation(..), ValidationChain (..), prettyValidation) import Data.Validity (Validation(..), ValidationChain (..), prettyValidation)
...@@ -26,13 +26,15 @@ import Gargantext.API.Errors.Types qualified as Errors ...@@ -26,13 +26,15 @@ import Gargantext.API.Errors.Types qualified as Errors
import Gargantext.API.Ngrams.Types qualified as Ngrams import Gargantext.API.Ngrams.Types qualified as Ngrams
import Gargantext.API.Node.Corpus.New (ApiInfo(..)) import Gargantext.API.Node.Corpus.New (ApiInfo(..))
import Gargantext.API.Node.Types (RenameNode(..), WithQuery(..)) import Gargantext.API.Node.Types (RenameNode(..), WithQuery(..))
import Gargantext.Core.AsyncUpdates.CentralExchange.Types qualified as CET
import Gargantext.Core.AsyncUpdates.Dispatcher.Types qualified as DET
import Gargantext.Core.NodeStory.Types qualified as NS
import Gargantext.Core.Notifications.CentralExchange.Types qualified as CET import Gargantext.Core.Notifications.CentralExchange.Types qualified as CET
import Gargantext.Core.Notifications.Dispatcher.Types qualified as DET import Gargantext.Core.Notifications.Dispatcher.Types qualified as DET
import Gargantext.Core.NodeStory.Types qualified as NS
import Gargantext.Core.Text.Ngrams (NgramsType(..)) import Gargantext.Core.Text.Ngrams (NgramsType(..))
import Gargantext.Core.Types.Main (ListType(CandidateTerm, StopTerm, MapTerm)) import Gargantext.Core.Types.Main (ListType(CandidateTerm, StopTerm, MapTerm))
import Gargantext.Database.Admin.Types.Node (UserId(UnsafeMkUserId))
import Gargantext.Database.Admin.Types.Hyperdata qualified as Hyperdata import Gargantext.Database.Admin.Types.Hyperdata qualified as Hyperdata
import Gargantext.Database.Admin.Types.Node (UserId(UnsafeMkUserId), NodeType(..))
import Gargantext.Prelude hiding (replace, Location) import Gargantext.Prelude hiding (replace, Location)
import Servant.Job.Core qualified as SJ import Servant.Job.Core qualified as SJ
import Servant.Job.Types qualified as SJ import Servant.Job.Types qualified as SJ
...@@ -266,6 +268,9 @@ genFrontendErr be = do ...@@ -266,6 +268,9 @@ genFrontendErr be = do
-> do userId <- arbitrary -> do userId <- arbitrary
roots <- arbitrary roots <- arbitrary
pure $ Errors.mkFrontendErr' txt (Errors.FE_node_lookup_failed_user_too_many_roots userId roots) 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 Errors.EC_404__node_context_not_found
-> do contextId <- arbitrary -> do contextId <- arbitrary
pure $ Errors.mkFrontendErr' txt (Errors.FE_node_context_not_found contextId) pure $ Errors.mkFrontendErr' txt (Errors.FE_node_context_not_found contextId)
......
...@@ -6,8 +6,8 @@ ...@@ -6,8 +6,8 @@
module Test.Offline.JSON (tests) where module Test.Offline.JSON (tests) where
import Data.Aeson import Data.Aeson
import Data.ByteString.Lazy.Char8 qualified as C8
import Data.ByteString qualified as B import Data.ByteString qualified as B
import Data.ByteString.Lazy.Char8 qualified as C8
import Data.Either import Data.Either
import Gargantext.API.Errors import Gargantext.API.Errors
import Gargantext.API.Node.Corpus.Types import Gargantext.API.Node.Corpus.Types
...@@ -15,6 +15,7 @@ import Gargantext.API.Node.Types ...@@ -15,6 +15,7 @@ import Gargantext.API.Node.Types
import Gargantext.API.Viz.Types import Gargantext.API.Viz.Types
import Gargantext.Core.Types.Phylo import Gargantext.Core.Types.Phylo
import qualified Gargantext.Core.Viz.Phylo as VizPhylo import qualified Gargantext.Core.Viz.Phylo as VizPhylo
import Gargantext.Database.Admin.Types.Hyperdata
import Gargantext.Database.Admin.Types.Node import Gargantext.Database.Admin.Types.Node
import Paths_gargantext import Paths_gargantext
import Prelude import Prelude
......
module Test.Server.ReverseProxy where module Test.Server.ReverseProxy where
import Control.Monad (void)
import Data.Function ((&)) import Data.Function ((&))
import Gargantext.MicroServices.ReverseProxy import Gargantext.MicroServices.ReverseProxy
import Network.HTTP.Client import Network.HTTP.Client
...@@ -52,7 +53,7 @@ writeFrameTests = sequential $ aroundAll withBackendServerAndProxy $ do ...@@ -52,7 +53,7 @@ writeFrameTests = sequential $ aroundAll withBackendServerAndProxy $ do
it "should allow authenticated requests" $ \(testEnv, serverPort, proxyPort) -> do it "should allow authenticated requests" $ \(testEnv, serverPort, proxyPort) -> do
-- Let's create the Alice user. -- Let's create the Alice user.
createAliceAndBob testEnv void $ createAliceAndBob testEnv
baseUrl <- parseBaseUrl "http://localhost" baseUrl <- parseBaseUrl "http://localhost"
manager <- newManager defaultManagerSettings manager <- newManager defaultManagerSettings
let clientEnv prt = mkClientEnv manager (baseUrl { baseUrlPort = prt }) let clientEnv prt = mkClientEnv manager (baseUrl { baseUrlPort = prt })
......
...@@ -7,6 +7,8 @@ import Gargantext.Prelude hiding (isInfixOf) ...@@ -7,6 +7,8 @@ import Gargantext.Prelude hiding (isInfixOf)
import Control.Concurrent.Async (asyncThreadId, withAsync) import Control.Concurrent.Async (asyncThreadId, withAsync)
import Control.Monad import Control.Monad
import Data.Text (isInfixOf) import Data.Text (isInfixOf)
import Gargantext.Core.AsyncUpdates.CentralExchange qualified as CE
import Gargantext.Core.AsyncUpdates.Dispatcher qualified as D
import Gargantext.Core.Notifications.CentralExchange qualified as CE import Gargantext.Core.Notifications.CentralExchange qualified as CE
import Gargantext.Core.Notifications.Dispatcher qualified as D import Gargantext.Core.Notifications.Dispatcher qualified as D
import Gargantext.Core.Notifications.Dispatcher.Types qualified as DT import Gargantext.Core.Notifications.Dispatcher.Types qualified as DT
...@@ -84,4 +86,3 @@ main = do ...@@ -84,4 +86,3 @@ main = do
DB.tests DB.tests
DB.nodeStoryTests DB.nodeStoryTests
runIO $ putText "tests finished" runIO $ putText "tests finished"
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