Verified Commit 4427590d authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski

Merge branch 'dev' into 603-dev-istex-zip-file-upload

parents 3dd27b5a 5dcd1840
## Version 0.0.6.9.9.8.2
* [FRONT][FIX][[User page] Fix the error message when the page loads (#604)](https://gitlab.iscpif.fr/gargantext/purescript-gargantext/issues/604)
* [FRONT][FIX][[Node content] Breadcrumb: display the full path of a node, as a breadcrumb (with each clickable parent) (#568)](https://gitlab.iscpif.fr/gargantext/purescript-gargantext/issues/568)
* [BACK][FIX][[Node content] Breadcrumb: display the full path of a node, as a breadcrumb (with each clickable parent) (#263)](https://gitlab.iscpif.fr/gargantext/haskell-gargantext/issues/263)
* [BACK][FIX][Post policy-manager fixups (#273)](https://gitlab.iscpif.fr/gargantext/haskell-gargantext/issues/273)
## Version 0.0.6.9.9.8.1 ## Version 0.0.6.9.9.8.1
* [BACK][FIX][Security considerations (#259)](https://gitlab.iscpif.fr/gargantext/haskell-gargantext/issues/259) * [BACK][FIX][Security considerations (#259)](https://gitlab.iscpif.fr/gargantext/haskell-gargantext/issues/259)
......
...@@ -5,7 +5,7 @@ cabal-version: 2.0 ...@@ -5,7 +5,7 @@ cabal-version: 2.0
-- see: https://github.com/sol/hpack -- see: https://github.com/sol/hpack
name: gargantext name: gargantext
version: 0.0.6.9.9.8.1 version: 0.0.6.9.9.8.2
synopsis: Search, map, share synopsis: Search, map, share
description: Please see README.md description: Please see README.md
category: Data category: Data
...@@ -995,6 +995,7 @@ test-suite garg-test-hspec ...@@ -995,6 +995,7 @@ test-suite garg-test-hspec
other-modules: other-modules:
Test.API Test.API
Test.API.Authentication Test.API.Authentication
Test.API.GraphQL
Test.API.Private Test.API.Private
Test.API.Setup Test.API.Setup
Test.Database.Operations Test.Database.Operations
......
...@@ -83,6 +83,7 @@ data Query m ...@@ -83,6 +83,7 @@ data Query m
, users :: GQLUser.UserArgs -> m [GQLUser.User m] , users :: GQLUser.UserArgs -> m [GQLUser.User m]
, tree :: GQLTree.TreeArgs -> m (GQLTree.TreeFirstLevel m) , tree :: GQLTree.TreeArgs -> m (GQLTree.TreeFirstLevel m)
, team :: GQLTeam.TeamArgs -> m GQLTeam.Team , team :: GQLTeam.TeamArgs -> m GQLTeam.Team
, tree_branch :: GQLTree.BreadcrumbArgs -> m (GQLTree.BreadcrumbInfo)
} deriving (Generic, GQLType) } deriving (Generic, GQLType)
data Mutation m data Mutation m
...@@ -130,7 +131,8 @@ rootResolver authenticatedUser policyManager = ...@@ -130,7 +131,8 @@ rootResolver authenticatedUser policyManager =
, user_infos = GQLUserInfo.resolveUserInfos authenticatedUser policyManager , user_infos = GQLUserInfo.resolveUserInfos authenticatedUser policyManager
, users = GQLUser.resolveUsers authenticatedUser policyManager , users = GQLUser.resolveUsers authenticatedUser policyManager
, tree = GQLTree.resolveTree authenticatedUser policyManager , tree = GQLTree.resolveTree authenticatedUser policyManager
, team = GQLTeam.resolveTeam } , team = GQLTeam.resolveTeam
, tree_branch = GQLTree.resolveBreadcrumb }
, mutationResolver = Mutation { update_user_info = GQLUserInfo.updateUserInfo , mutationResolver = Mutation { update_user_info = GQLUserInfo.updateUserInfo
, update_user_pubmed_api_key = GQLUser.updateUserPubmedAPIKey , update_user_pubmed_api_key = GQLUser.updateUserPubmedAPIKey
, delete_team_membership = GQLTeam.deleteTeamMembership , delete_team_membership = GQLTeam.deleteTeamMembership
......
...@@ -42,6 +42,16 @@ data TreeFirstLevel m = TreeFirstLevel ...@@ -42,6 +42,16 @@ data TreeFirstLevel m = TreeFirstLevel
, children :: [TreeNode] , children :: [TreeNode]
} deriving (Generic, GQLType) } deriving (Generic, GQLType)
data BreadcrumbArgs = BreadcrumbArgs
{
node_id :: Int
} deriving (Generic, GQLType)
data BreadcrumbInfo = BreadcrumbInfo
{
parents :: [TreeNode]
} deriving (Generic, GQLType)
type ParentId = Maybe NodeId type ParentId = Maybe NodeId
resolveTree :: (CmdCommon env) resolveTree :: (CmdCommon env)
...@@ -97,3 +107,22 @@ nodeToTreeNode N.Node {..} = if (fromNodeTypeId _node_typename /= NN.NodeFolderS ...@@ -97,3 +107,22 @@ nodeToTreeNode N.Node {..} = if (fromNodeTypeId _node_typename /= NN.NodeFolderS
} }
else else
Nothing Nothing
resolveBreadcrumb :: (CmdCommon env) => BreadcrumbArgs -> GqlM e env (BreadcrumbInfo)
resolveBreadcrumb BreadcrumbArgs { node_id } = dbRecursiveParents node_id
convertDbTreeToTreeNode :: 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 = fromNodeTypeId _dt_typeId
, parent_id = NN.unNodeId <$> _dt_parentId
}
dbRecursiveParents :: (CmdCommon env) => Int -> GqlM e env (BreadcrumbInfo)
dbRecursiveParents node_id = do
let nId = NodeId node_id
dbParents <- lift $ T.recursiveParents nId allNodeTypes
let treeNodes = map convertDbTreeToTreeNode dbParents
let breadcrumbInfo = BreadcrumbInfo { parents = treeNodes }
pure breadcrumbInfo
...@@ -50,7 +50,8 @@ resolveUsers ...@@ -50,7 +50,8 @@ resolveUsers
-> UserArgs -> UserArgs
-> GqlM e env [User (GqlM e env)] -> GqlM e env [User (GqlM e env)]
resolveUsers autUser mgr UserArgs { user_id } = do resolveUsers autUser mgr UserArgs { user_id } = do
withPolicy autUser mgr (nodeChecks (NodeId user_id)) $ dbUsers user_id -- FIXME(adn) we should use a proper policy, not 'alwaysAllow'.
withPolicy autUser mgr alwaysAllow $ dbUsers user_id
-- | Inner function to fetch the user from DB. -- | Inner function to fetch the user from DB.
dbUsers dbUsers
......
...@@ -49,7 +49,7 @@ import Gargantext.API.GraphQL.Types ...@@ -49,7 +49,7 @@ import Gargantext.API.GraphQL.Types
import Gargantext.API.Admin.Auth.Types hiding (Valid) import Gargantext.API.Admin.Auth.Types hiding (Valid)
import Gargantext.API.Auth.PolicyCheck import Gargantext.API.Auth.PolicyCheck
import Gargantext.API.GraphQL.PolicyCheck import Gargantext.API.GraphQL.PolicyCheck
import Gargantext.Database.Admin.Types.Node -- import Gargantext.Database.Admin.Types.Node
data UserInfo = UserInfo data UserInfo = UserInfo
{ ui_id :: Int { ui_id :: Int
...@@ -108,7 +108,8 @@ resolveUserInfos ...@@ -108,7 +108,8 @@ resolveUserInfos
-> AccessPolicyManager -> AccessPolicyManager
-> UserInfoArgs -> GqlM e env [UserInfo] -> UserInfoArgs -> GqlM e env [UserInfo]
resolveUserInfos autUser mgr UserInfoArgs { user_id } = resolveUserInfos autUser mgr UserInfoArgs { user_id } =
withPolicy autUser mgr (nodeChecks (NodeId user_id)) $ dbUsers user_id -- FIXME(adn) we should use a proper policy, not 'alwaysAllow'.
withPolicy autUser mgr alwaysAllow $ dbUsers user_id
-- | Mutation for user info -- | Mutation for user info
updateUserInfo updateUserInfo
......
...@@ -37,6 +37,7 @@ module Gargantext.Database.Query.Tree ...@@ -37,6 +37,7 @@ module Gargantext.Database.Query.Tree
, sharedTreeUpdate , sharedTreeUpdate
, dbTree , dbTree
, updateTree , updateTree
, recursiveParents
) )
where where
...@@ -389,4 +390,27 @@ isIn cId docId = ( == [Only True]) ...@@ -389,4 +390,27 @@ isIn cId docId = ( == [Only True])
WHERE nn.node1_id = ? WHERE nn.node1_id = ?
AND nn.node2_id = ?; AND nn.node2_id = ?;
|] (cId, docId) |] (cId, docId)
-- Recursive parents function to construct a breadcrumb
recursiveParents :: NodeId
-> [NodeType]
-> Cmd err [DbTreeNode]
recursiveParents nodeId nodeTypes = map (\(nId, tId, pId, n) -> DbTreeNode nId tId pId n)
<$> runPGSQuery [sql|
WITH RECURSIVE recursiveParents AS
(
SELECT id, typename, parent_id, name, 1 as original_order
FROM public.nodes WHERE id = ?
UNION ALL
SELECT n.id, n.typename, n.parent_id, n.name, rp.original_order+1
FROM public.nodes n
INNER JOIN recursiveParents rp ON n.id = rp.parent_id
WHERE n.typename IN ?
) SELECT id, typename, parent_id, name FROM recursiveParents ORDER BY original_order DESC;
|] (nodeId, In typename)
where
typename = map nodeTypeId ns
ns = case nodeTypes of
[] -> allNodeTypes
_ -> nodeTypes
----------------------------------------------------- -----------------------------------------------------
...@@ -5,8 +5,10 @@ import Prelude ...@@ -5,8 +5,10 @@ import Prelude
import Test.Hspec import Test.Hspec
import qualified Test.API.Authentication as Auth import qualified Test.API.Authentication as Auth
import qualified Test.API.Private as Private import qualified Test.API.Private as Private
import qualified Test.API.GraphQL as GraphQL
tests :: Spec tests :: Spec
tests = describe "API" $ do tests = describe "API" $ do
Auth.tests Auth.tests
Private.tests Private.tests
GraphQL.tests
...@@ -47,7 +47,9 @@ tests = sequential $ aroundAll withTestDBAndPort $ do ...@@ -47,7 +47,9 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
let version_api = client (Proxy :: Proxy (MkGargAPI (GargAPIVersion GargVersion))) let version_api = client (Proxy :: Proxy (MkGargAPI (GargAPIVersion GargVersion)))
it "requires no auth and returns the current version" $ \((_testEnv, port), _) -> do it "requires no auth and returns the current version" $ \((_testEnv, port), _) -> do
result <- runClientM version_api (clientEnv port) result <- runClientM version_api (clientEnv port)
result `shouldBe` (Right "0.0.6.9.9.8") case result of
Left err -> fail (show err)
Right r -> r `shouldSatisfy` ((>= 1) . T.length) -- we got something back
describe "POST /api/v1.0/auth" $ do describe "POST /api/v1.0/auth" $ do
......
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE QuasiQuotes #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module Test.API.GraphQL (
tests
) where
import Gargantext.Core.Types.Individu
import Prelude
import Servant.Auth.Client ()
import Test.API.Private (withValidLogin, protected)
import Test.API.Setup (withTestDBAndPort, setupEnvironment, createAliceAndBob)
import Test.Hspec
import Test.Hspec.Wai.Internal (withApplication)
import Test.Utils
import Text.RawString.QQ (r)
tests :: Spec
tests = sequential $ aroundAll withTestDBAndPort $ do
describe "Prelude" $ do
it "setup DB triggers" $ \((testEnv, _), _) -> setupEnvironment testEnv
describe "GraphQL" $ do
describe "get_user_infos" $ do
it "allows 'alice' to see her own info" $ \((testEnv, port), app) -> do
createAliceAndBob testEnv
withApplication app $ do
withValidLogin port "alice" (GargPassword "alice") $ \token -> do
protected token "POST" "/gql" [r| {
"query": "{ user_infos(user_id: 2) { ui_id, ui_email } }"
} |] `shouldRespondWith'` [jsonFragment| {"data":{"user_infos":[{"ui_id":2,"ui_email":"alice@gargan.text"}]}} |]
...@@ -3,7 +3,14 @@ ...@@ -3,7 +3,14 @@
{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ScopedTypeVariables #-}
module Test.API.Private where module Test.API.Private (
tests
-- * Utility functions
, withValidLogin
, getJSON
, protected
) where
import Control.Exception import Control.Exception
import Control.Monad import Control.Monad
...@@ -11,11 +18,9 @@ import Control.Monad.Reader ...@@ -11,11 +18,9 @@ import Control.Monad.Reader
import Data.ByteString (ByteString) import Data.ByteString (ByteString)
import Data.Maybe import Data.Maybe
import Data.Proxy import Data.Proxy
import Fmt
import Gargantext.API.Admin.Auth.Types import Gargantext.API.Admin.Auth.Types
import Gargantext.API.Routes import Gargantext.API.Routes
import Gargantext.Core.Types.Individu import Gargantext.Core.Types.Individu
import Gargantext.Database.Action.User.New
import Network.HTTP.Client hiding (Proxy) import Network.HTTP.Client hiding (Proxy)
import Network.HTTP.Types import Network.HTTP.Types
import Network.Wai.Test (SResponse) import Network.Wai.Test (SResponse)
...@@ -24,27 +29,16 @@ import Servant ...@@ -24,27 +29,16 @@ import Servant
import Servant.Auth.Client () import Servant.Auth.Client ()
import Servant.Client import Servant.Client
import Test.API.Authentication (auth_api) import Test.API.Authentication (auth_api)
import Test.API.Setup (withTestDBAndPort, setupEnvironment) import Test.API.Setup (withTestDBAndPort, setupEnvironment, mkUrl, createAliceAndBob)
import Test.Database.Types
import Test.Hspec import Test.Hspec
import Test.Hspec.Wai hiding (pendingWith) import Test.Hspec.Wai hiding (pendingWith)
import Test.Hspec.Wai.Internal (withApplication) import Test.Hspec.Wai.Internal (withApplication)
import Test.Hspec.Wai.JSON (json)
import Test.Utils (jsonFragment, shouldRespondWith') import Test.Utils (jsonFragment, shouldRespondWith')
import qualified Data.ByteString.Lazy as L import qualified Data.ByteString.Lazy as L
import qualified Data.Text.Encoding as TE import qualified Data.Text.Encoding as TE
import qualified Network.Wai.Handler.Warp as Wai import qualified Network.Wai.Handler.Warp as Wai
import qualified Servant.Auth.Client as SA import qualified Servant.Auth.Client as SA
type Env = ((TestEnv, Wai.Port), Application)
curApi :: Builder
curApi = "v1.0"
mkUrl :: Wai.Port -> Builder -> ByteString
mkUrl _port urlPiece =
"/api/" +| curApi |+ urlPiece
-- | Issue a request with a valid 'Authorization: Bearer' inside. -- | Issue a request with a valid 'Authorization: Bearer' inside.
protected :: Token -> Method -> ByteString -> L.ByteString -> WaiSession () SResponse protected :: Token -> Method -> ByteString -> L.ByteString -> WaiSession () SResponse
protected tkn mth url payload = protected tkn mth url payload =
...@@ -57,7 +51,7 @@ getJSON :: ByteString -> WaiSession () SResponse ...@@ -57,7 +51,7 @@ getJSON :: ByteString -> WaiSession () SResponse
getJSON url = getJSON url =
request "GET" url [(hContentType, "application/json")] "" request "GET" url [(hContentType, "application/json")] ""
withValidLogin :: MonadIO m => Wai.Port -> Username -> GargPassword -> (Token -> m a) -> m a withValidLogin :: (MonadFail m, MonadIO m) => Wai.Port -> Username -> GargPassword -> (Token -> m a) -> m a
withValidLogin port ur pwd act = do withValidLogin port ur pwd act = do
baseUrl <- liftIO $ parseBaseUrl "http://localhost" baseUrl <- liftIO $ parseBaseUrl "http://localhost"
manager <- liftIO $ newManager defaultManagerSettings manager <- liftIO $ newManager defaultManagerSettings
...@@ -66,7 +60,11 @@ withValidLogin port ur pwd act = do ...@@ -66,7 +60,11 @@ withValidLogin port ur pwd act = do
result <- liftIO $ runClientM (auth_api authPayload) clientEnv result <- liftIO $ runClientM (auth_api authPayload) clientEnv
case result of case result of
Left err -> liftIO $ throwIO $ userError (show err) Left err -> liftIO $ throwIO $ userError (show err)
Right res -> let token = _authVal_token $ fromJust (_authRes_valid res) in act token Right res
| Just tkn <- _authRes_valid res
-> act (_authVal_token tkn)
| otherwise
-> fail $ "No token found in " <> show res
tests :: Spec tests :: Spec
...@@ -83,14 +81,7 @@ tests = sequential $ aroundAll withTestDBAndPort $ do ...@@ -83,14 +81,7 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
-- FIXME(adn): unclear if this is useful at all. Doesn't do permission checking. -- FIXME(adn): unclear if this is useful at all. Doesn't do permission checking.
it "doesn't allow someone with an invalid token to show the results" $ \((testEnv, port), _) -> do it "doesn't allow someone with an invalid token to show the results" $ \((testEnv, port), _) -> do
-- Let's create two users, Alice & Bob. Alice shouldn't be able to see createAliceAndBob testEnv
-- Bob's private data and vice-versa.
void $ 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
let ( roots_api :<|> _nodes_api let ( roots_api :<|> _nodes_api
) = client (Proxy :: Proxy (MkProtectedAPI GargAdminAPI)) (SA.Token "bogus") ) = client (Proxy :: Proxy (MkProtectedAPI GargAdminAPI)) (SA.Token "bogus")
......
...@@ -3,6 +3,9 @@ ...@@ -3,6 +3,9 @@
module Test.API.Setup where module Test.API.Setup where
import Control.Lens import Control.Lens
import Control.Monad.Reader
import Data.ByteString (ByteString)
import Fmt (Builder, (+|), (|+))
import Gargantext.API (makeApp) import Gargantext.API (makeApp)
import Gargantext.API.Admin.EnvTypes (Mode(Mock), Env (..)) import Gargantext.API.Admin.EnvTypes (Mode(Mock), Env (..))
import Gargantext.API.Admin.Settings import Gargantext.API.Admin.Settings
...@@ -10,9 +13,12 @@ import Gargantext.API.Admin.Types ...@@ -10,9 +13,12 @@ import Gargantext.API.Admin.Types
import Gargantext.API.Prelude import Gargantext.API.Prelude
import Gargantext.Core.NLP import Gargantext.Core.NLP
import Gargantext.Core.NodeStory import Gargantext.Core.NodeStory
import Gargantext.Core.Types.Individu
import Gargantext.Database.Action.Flow import Gargantext.Database.Action.Flow
import Gargantext.Database.Action.User.New
import Gargantext.Database.Admin.Config (userMaster, corpusMasterName) import Gargantext.Database.Admin.Config (userMaster, corpusMasterName)
import Gargantext.Database.Admin.Trigger.Init import Gargantext.Database.Admin.Trigger.Init
import Gargantext.Database.Admin.Types.Hyperdata
import Gargantext.Database.Prelude import Gargantext.Database.Prelude
import Gargantext.Database.Query.Table.Node (getOrMkList) import Gargantext.Database.Query.Table.Node (getOrMkList)
import Gargantext.Prelude.Config import Gargantext.Prelude.Config
...@@ -31,11 +37,8 @@ import qualified Gargantext.Utils.Jobs.Monad as Jobs ...@@ -31,11 +37,8 @@ import qualified Gargantext.Utils.Jobs.Monad as Jobs
import qualified Gargantext.Utils.Jobs.Queue as Jobs import qualified Gargantext.Utils.Jobs.Queue as Jobs
import qualified Gargantext.Utils.Jobs.Settings as Jobs import qualified Gargantext.Utils.Jobs.Settings as Jobs
import qualified Network.Wai.Handler.Warp as Warp import qualified Network.Wai.Handler.Warp as Warp
import qualified Network.Wai.Handler.Warp as Wai
import qualified Servant.Job.Async as ServantAsync import qualified Servant.Job.Async as ServantAsync
import Gargantext.Database.Admin.Types.Hyperdata
import Control.Monad.Reader
import Gargantext.Core.Types.Individu
import Gargantext.Database.Action.User.New
newTestEnv :: TestEnv -> Logger (GargM Env GargError) -> Warp.Port -> IO Env newTestEnv :: TestEnv -> Logger (GargM Env GargError) -> Warp.Port -> IO Env
...@@ -99,3 +102,21 @@ setupEnvironment env = flip runReaderT env $ runTestMonad $ do ...@@ -99,3 +102,21 @@ setupEnvironment env = flip runReaderT env $ runTestMonad $ do
(Nothing :: Maybe HyperdataCorpus) (Nothing :: Maybe HyperdataCorpus)
masterListId <- getOrMkList masterCorpusId masterUserId masterListId <- getOrMkList masterCorpusId masterUserId
void $ initLastTriggers masterListId void $ initLastTriggers masterListId
-- | Creates two users, Alice & Bob. Alice shouldn't be able to see
-- Bob's private data and vice-versa.
createAliceAndBob :: TestEnv -> IO ()
createAliceAndBob testEnv = do
void $ 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
curApi :: Builder
curApi = "v1.0"
mkUrl :: Wai.Port -> Builder -> ByteString
mkUrl _port urlPiece =
"/api/" +| curApi |+ urlPiece
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