Commit 4e054277 authored by Alfredo Di Napoli's avatar Alfredo Di Napoli

Add policy protection to some GraphQL routes

parent 8eb55509
......@@ -164,8 +164,10 @@ library
Gargantext.API.GraphQL.IMT
Gargantext.API.GraphQL.NLP
Gargantext.API.GraphQL.Node
Gargantext.API.GraphQL.PolicyCheck
Gargantext.API.GraphQL.Team
Gargantext.API.GraphQL.TreeFirstLevel
Gargantext.API.GraphQL.Types
Gargantext.API.GraphQL.User
Gargantext.API.GraphQL.UserInfo
Gargantext.API.GraphQL.Utils
......
......@@ -170,14 +170,12 @@ withPolicy :: GargServerC env GargError m
-> m a
-> AccessPolicyManager
-> m a
withPolicy ur checks h mgr = do
a <- h
case mgr of
AccessPolicyManager{runAccessPolicy} -> do
res <- runAccessPolicy ur checks
case res of
Allow -> pure a
Deny err -> throwError $ GargServerError $ err
withPolicy ur checks m mgr = case mgr of
AccessPolicyManager{runAccessPolicy} -> do
res <- runAccessPolicy ur checks
case res of
Allow -> m
Deny err -> throwError $ GargServerError $ err
{- | Collaborative Schema
User at his root can create Teams Folder
......
......@@ -16,6 +16,7 @@ module Gargantext.API.Auth.PolicyCheck (
, nodeUser
, nodeChecks
, alwaysAllow
, alwaysDeny
) where
import Control.Lens
......@@ -78,6 +79,7 @@ data AccessCheck
| AC_master_user NodeId
-- | Always grant access, effectively a public route.
| AC_always_allow
| AC_always_deny
deriving (Show, Eq)
-------------------------------------------------------------------------------
......@@ -117,6 +119,8 @@ accessPolicyManager = AccessPolicyManager (\ur ac -> interpretPolicy ur ac)
check :: HasNodeError err => AuthenticatedUser -> AccessCheck -> DBCmd err AccessResult
check (AuthenticatedUser loggedUserNodeId) = \case
AC_always_deny
-> pure $ Deny err500
AC_always_allow
-> pure Allow
AC_user_node requestedNodeId
......@@ -149,6 +153,9 @@ nodeChecks nid =
alwaysAllow :: BoolExpr AccessCheck
alwaysAllow = BConst . Positive $ AC_always_allow
alwaysDeny :: BoolExpr AccessCheck
alwaysDeny = BConst . Positive $ AC_always_deny
-------------------------------------------------------------------------------
-- Instances
-------------------------------------------------------------------------------
......
......@@ -63,6 +63,7 @@ import Servant
import qualified Servant.Auth as SA
import qualified Servant.Auth.Server as SAS
import Gargantext.API.Admin.Types (HasSettings)
import Gargantext.API.Auth.PolicyCheck
-- | Represents possible GraphQL queries.
......@@ -111,8 +112,10 @@ data Contet m
-- subscriptions are handled.
rootResolver
:: (CmdCommon env, HasNLPServer env, HasJobEnv' env, HasSettings env)
=> RootResolver (GargM env GargError) e Query Mutation Undefined
rootResolver =
=> AuthenticatedUser
-> AccessPolicyManager
-> RootResolver (GargM env GargError) e Query Mutation Undefined
rootResolver authenticatedUser policyManager =
RootResolver
{ queryResolver = Query { annuaire_contacts = GQLA.resolveAnnuaireContacts
, context_ngrams = GQLCTX.resolveContextNgrams
......@@ -121,12 +124,12 @@ rootResolver =
, imt_schools = GQLIMT.resolveSchools
, job_logs = GQLAT.resolveJobLogs
, languages = GQLNLP.resolveLanguages
, nodes = GQLNode.resolveNodes
, nodes = GQLNode.resolveNodes authenticatedUser policyManager
, nodes_corpus = GQLNode.resolveNodesCorpus
, node_parent = GQLNode.resolveNodeParent
, user_infos = GQLUserInfo.resolveUserInfos
, users = GQLUser.resolveUsers
, tree = GQLTree.resolveTree
, user_infos = GQLUserInfo.resolveUserInfos authenticatedUser policyManager
, users = GQLUser.resolveUsers authenticatedUser policyManager
, tree = GQLTree.resolveTree authenticatedUser policyManager
, team = GQLTeam.resolveTeam }
, mutationResolver = Mutation { update_user_info = GQLUserInfo.updateUserInfo
, update_user_pubmed_api_key = GQLUser.updateUserPubmedAPIKey
......@@ -137,8 +140,10 @@ rootResolver =
-- | Main GraphQL "app".
app
:: (Typeable env, CmdCommon env, HasJobEnv' env, HasNLPServer env, HasSettings env)
=> App (EVENT (GargM env GargError)) (GargM env GargError)
app = deriveApp rootResolver
=> AuthenticatedUser
-> AccessPolicyManager
-> App (EVENT (GargM env GargError)) (GargM env GargError)
app authenticatedUser policyManager = deriveApp (rootResolver authenticatedUser policyManager)
----------------------------------------------
......@@ -153,7 +158,7 @@ type Playground = Get '[HTML] ByteString
-- type API' (name :: Symbol) = name :> (GQAPI :<|> Schema :<|> Playground)
-- | Our API consists of `GQAPI` and `Playground`.
type API = SA.Auth '[SA.JWT, SA.Cookie] AuthenticatedUser
:> "gql" :> (GQAPI :<|> Playground)
:> "gql" :> (PolicyChecked GQAPI :<|> Playground)
gqapi :: Proxy API
gqapi = Proxy
......@@ -175,5 +180,5 @@ gqapi = Proxy
api
:: (Typeable env, CmdCommon env, HasJobEnv' env, HasSettings env)
=> ServerT API (GargM env GargError)
api (SAS.Authenticated _auser) = httpPubApp [] app :<|> pure httpPlayground
api _ = panic "401 in graphql" -- SAS.throwAll (_ServerError # err401)
api (SAS.Authenticated auser) = (httpPubApp [] . app auser) :<|> pure httpPlayground
api _ = panic "401 in graphql" -- SAS.throwAll (_ServerError # err401)
......@@ -6,13 +6,10 @@ module Gargantext.API.GraphQL.Annuaire where
import Control.Lens
import Data.Morpheus.Types
( GQLType
, Resolver
, QUERY
, lift
)
import Data.Proxy
import Data.Text (Text)
import Gargantext.API.Prelude (GargM, GargError)
import Gargantext.Database.Admin.Types.Hyperdata.Contact
( HyperdataContact
, ContactWho
......@@ -25,6 +22,7 @@ import Gargantext.Database.Query.Table.Context (getContextWith)
import Gargantext.Database.Schema.Node (node_hyperdata)
import Gargantext.Prelude
import GHC.Generics (Generic)
import Gargantext.API.GraphQL.Types
data AnnuaireContact = AnnuaireContact
{ ac_title :: !(Maybe Text)
......@@ -50,8 +48,6 @@ data AnnuaireContactArgs
{ contact_id :: Int
} deriving (Generic, GQLType)
type GqlM e env = Resolver QUERY e (GargM env GargError)
-- | Function to resolve user from a query.
resolveAnnuaireContacts
:: (CmdCommon env)
......
......@@ -8,22 +8,16 @@ module Gargantext.API.GraphQL.IMT
)
where
import Data.Morpheus.Types
( GQLType
, Resolver
, QUERY
)
import Gargantext.API.Prelude (GargM, GargError)
import Data.Morpheus.Types (GQLType)
import GHC.Generics (Generic)
import Gargantext.API.GraphQL.Types
import Gargantext.Core.Ext.IMT (School(..), schools)
import Gargantext.Prelude
import GHC.Generics (Generic)
data SchoolsArgs
= SchoolsArgs
{ } deriving (Generic, GQLType)
type GqlM e env = Resolver QUERY e (GargM env GargError)
resolveSchools
:: SchoolsArgs -> GqlM e env [School]
resolveSchools SchoolsArgs { } = pure $ schools
......@@ -10,24 +10,18 @@ module Gargantext.API.GraphQL.NLP
where
import Control.Lens (view)
import qualified Data.Map.Strict as Map
import Data.Morpheus.Types
( GQLType
, Resolver
, QUERY
)
import Gargantext.API.Prelude (GargM, GargError)
import Data.Morpheus.Types (GQLType)
import Gargantext.API.GraphQL.Types
import Gargantext.Core (Lang(..), NLPServerConfig(..), PosTagAlgo) -- , allLangs)
import Gargantext.Core.NLP (HasNLPServer(..))
import Gargantext.Prelude
import Protolude
import qualified Data.Map.Strict as Map
data LanguagesArgs
= LanguagesArgs
{ } deriving (Generic, GQLType)
type GqlM e env = Resolver QUERY e (GargM env GargError)
type LanguagesMap = Map.Map Lang NLPServer
data NLPServer = NLPServer
......
......@@ -3,28 +3,27 @@
module Gargantext.API.GraphQL.Node where
import Control.Monad.Except (lift)
import Data.Aeson
import Data.Either (Either(..))
import qualified Data.HashMap.Strict as HashMap
import Data.Morpheus.Types
( GQLType
, Resolver
, QUERY
, lift
)
import Data.Morpheus.Types ( GQLType )
import Data.Text (Text)
import qualified Data.Text as T
import Gargantext.API.Prelude (GargM, GargError)
import GHC.Generics (Generic)
import Gargantext.API.Admin.Auth.Types
import Gargantext.API.Auth.PolicyCheck
import Gargantext.API.GraphQL.PolicyCheck (withPolicy)
import Gargantext.API.GraphQL.Types
import Gargantext.Database.Admin.Types.Node (NodeId(..), NodeType)
import qualified Gargantext.Database.Admin.Types.Node as NN
import Gargantext.Database.Query.Table.Node (getClosestParentIdByType, getNode)
import Gargantext.Database.Prelude (CmdCommon) -- , JSONB)
import qualified Gargantext.Database.Schema.Node as N
import Gargantext.Database.Query.Table.Node (getClosestParentIdByType, getNode)
import Gargantext.Prelude
import GHC.Generics (Generic)
import qualified Prelude
import qualified PUBMED.Types as PUBMED
import Text.Read (readEither)
import qualified Data.HashMap.Strict as HashMap
import qualified Data.Text as T
import qualified Gargantext.Database.Admin.Types.Node as NN
import qualified Gargantext.Database.Schema.Node as N
import qualified PUBMED.Types as PUBMED
import qualified Prelude
data Corpus = Corpus
{ id :: Int
......@@ -50,13 +49,15 @@ data NodeArgs
{ node_id :: Int
} deriving (Generic, GQLType)
type GqlM e env = Resolver QUERY e (GargM env GargError)
-- | Function to resolve user from a query.
resolveNodes
:: (CmdCommon env)
=> NodeArgs -> GqlM e env [Node]
resolveNodes NodeArgs { node_id } = dbNodes node_id
=> AuthenticatedUser
-> AccessPolicyManager
-> NodeArgs
-> GqlM e env [Node]
resolveNodes autUser mgr NodeArgs { node_id } =
withPolicy autUser mgr (nodeChecks (NodeId node_id)) $ dbNodes node_id
resolveNodesCorpus
:: (CmdCommon env)
......
module Gargantext.API.GraphQL.PolicyCheck where
import Prelude
import Control.Monad.Except
import Gargantext.API.Admin.Auth.Types
import Gargantext.API.Auth.PolicyCheck
import Gargantext.API.GraphQL.Types
import Gargantext.API.Prelude
import Gargantext.Database.Prelude
withPolicy :: (HasConnectionPool env, HasConfig env)
=> AuthenticatedUser
-> AccessPolicyManager
-> BoolExpr AccessCheck
-> GqlM e env a
-> GqlM e env a
withPolicy ur mgr checks m = case mgr of
AccessPolicyManager{runAccessPolicy} -> do
res <- lift $ runAccessPolicy ur checks
case res of
Allow -> m
Deny err -> lift $ throwError $ GargServerError $ err
......@@ -3,23 +3,23 @@
module Gargantext.API.GraphQL.Team where
import Gargantext.Prelude
import GHC.Generics (Generic)
import Data.Morpheus.Types (GQLType, Resolver, QUERY, ResolverM, lift)
import Data.Morpheus.Types (GQLType, ResolverM, lift)
import Data.Text ( Text )
import GHC.Generics (Generic)
import Gargantext.API.Admin.Types (HasSettings)
import Gargantext.API.GraphQL.Types (GqlM)
import Gargantext.API.GraphQL.Utils (authUser, AuthStatus (Invalid, Valid))
import Gargantext.API.Prelude (GargM, GargError)
import Gargantext.Core.Types (NodeId(..), unNodeId)
import qualified Gargantext.Core.Types.Individu as Individu
import Gargantext.Database.Action.Share (membersOf, deleteMemberShip)
import Gargantext.Database.Prelude (CmdCommon)
import Gargantext.Database.Query.Table.Node (getNode)
import Gargantext.Database.Query.Table.User (getUsersWithNodeHyperdata)
import Gargantext.Database.Schema.Node (NodePoly(Node, _node_id), _node_user_id)
import qualified Data.Text as T
import Gargantext.Database.Schema.User (UserLight(..))
import Gargantext.Prelude
import qualified Data.Text as T
import qualified Gargantext.Core.Types.Individu as Individu
data TeamArgs = TeamArgs
{ team_node_id :: Int } deriving (Generic, GQLType)
......@@ -40,10 +40,8 @@ data TeamDeleteMArgs = TeamDeleteMArgs
, team_node_id :: Int
} deriving (Generic, GQLType)
type GqlM e env = Resolver QUERY e (GargM env GargError)
type GqlM' e env a = ResolverM e (GargM env GargError) a
resolveTeam :: (CmdCommon env) => TeamArgs -> GqlM e env Team
resolveTeam TeamArgs { team_node_id } = dbTeam team_node_id
......
......@@ -3,10 +3,13 @@
module Gargantext.API.GraphQL.TreeFirstLevel where
import Data.Morpheus.Types (GQLType, lift, Resolver, QUERY)
import Data.Morpheus.Types (GQLType, lift)
import Data.Text (Text)
import GHC.Generics (Generic)
import Gargantext.API.Prelude (GargM, GargError)
import Gargantext.API.Admin.Auth.Types
import Gargantext.API.Auth.PolicyCheck
import Gargantext.API.GraphQL.PolicyCheck
import Gargantext.API.GraphQL.Types
import Gargantext.Core.Types (Tree, NodeTree, NodeType)
import Gargantext.Core.Types.Main ( Tree(TreeN), _tn_node, _tn_children, NodeTree(NodeTree, _nt_id, _nt_type), _nt_name )
import Gargantext.Database.Admin.Config (fromNodeTypeId)
......@@ -39,12 +42,15 @@ data TreeFirstLevel m = TreeFirstLevel
, children :: [TreeNode]
} deriving (Generic, GQLType)
type GqlM e env = Resolver QUERY e (GargM env GargError)
type ParentId = Maybe NodeId
resolveTree :: (CmdCommon env) => TreeArgs -> GqlM e env (TreeFirstLevel (GqlM e env))
resolveTree TreeArgs { root_id } = dbTree root_id
resolveTree :: (CmdCommon env)
=> AuthenticatedUser
-> AccessPolicyManager
-> TreeArgs
-> GqlM e env (TreeFirstLevel (GqlM e env))
resolveTree autUser mgr TreeArgs { root_id } =
withPolicy autUser mgr (nodeChecks (NodeId root_id)) $ dbTree root_id
dbTree :: (CmdCommon env) =>
Int -> GqlM e env (TreeFirstLevel (GqlM e env))
......
module Gargantext.API.GraphQL.Types where
import Data.Morpheus.Types
import Gargantext.API.Prelude
type GqlM e env = Resolver QUERY e (GargM env GargError)
type GqlM' e env a = ResolverM e (GargM env GargError) a
......@@ -6,20 +6,22 @@ module Gargantext.API.GraphQL.User where
import Data.Maybe (listToMaybe)
import Data.Morpheus.Types
( GQLType
, Resolver, ResolverM, QUERY
, lift
)
import Data.Text (Text)
import GHC.Generics (Generic)
import Gargantext.API.Admin.Types (HasSettings)
import Gargantext.API.Prelude (GargM, GargError)
import Gargantext.API.GraphQL.Types
import Gargantext.Database.Admin.Types.Hyperdata (HyperdataUser(..))
import Gargantext.Database.Admin.Types.Node (NodeId(..))
import Gargantext.Database.Prelude (CmdCommon)
import qualified Gargantext.Database.Query.Table.User as DBUser
import Gargantext.Database.Schema.User (UserLight(..))
import Gargantext.Prelude
import GHC.Generics (Generic)
import qualified Gargantext.Core.Types.Individu as Individu
import qualified Gargantext.Database.Query.Table.User as DBUser
import Gargantext.API.Admin.Auth.Types
import Gargantext.API.Auth.PolicyCheck
import Gargantext.API.GraphQL.PolicyCheck
data User m = User
{ u_email :: Text
......@@ -40,14 +42,15 @@ data UserPubmedAPIKeyMArgs
, api_key :: Text }
deriving (Generic, GQLType)
type GqlM e env = Resolver QUERY e (GargM env GargError)
type GqlM' e env a = ResolverM e (GargM env GargError) a
-- | Function to resolve user from a query.
resolveUsers
:: (CmdCommon env)
=> UserArgs -> GqlM e env [User (GqlM e env)]
resolveUsers UserArgs { user_id } = dbUsers user_id
=> AuthenticatedUser
-> AccessPolicyManager
-> UserArgs
-> GqlM e env [User (GqlM e env)]
resolveUsers autUser mgr UserArgs { user_id } = do
withPolicy autUser mgr (nodeChecks (NodeId user_id)) $ dbUsers user_id
-- | Inner function to fetch the user from DB.
dbUsers
......
......@@ -7,15 +7,11 @@ import Control.Lens
import Data.Maybe (fromMaybe)
import Data.Morpheus.Types
( GQLType
, Resolver
, ResolverM
, QUERY
, description
, lift
)
import Data.Text (Text)
import qualified Data.Text as T
import Gargantext.API.Prelude (GargM, GargError)
import Gargantext.Database.Admin.Types.Hyperdata
( HyperdataUser(..)
, hc_source
......@@ -49,6 +45,11 @@ import GHC.Generics (Generic)
import Gargantext.API.GraphQL.Utils (AuthStatus(Invalid, Valid), authUser)
import Gargantext.API.Admin.Types (HasSettings)
import qualified Gargantext.Core.Types.Individu as Individu
import Gargantext.API.GraphQL.Types
import Gargantext.API.Admin.Auth.Types hiding (Valid)
import Gargantext.API.Auth.PolicyCheck
import Gargantext.API.GraphQL.PolicyCheck
import Gargantext.Database.Admin.Types.Node
data UserInfo = UserInfo
{ ui_id :: Int
......@@ -100,20 +101,20 @@ data UserInfoMArgs
, ui_cwDescription :: Maybe Text
} deriving (Generic, GQLType)
type GqlM e env = Resolver QUERY e (GargM env GargError)
type GqlM' e env err = ResolverM e (GargM env err) Int
-- | Function to resolve user from a query.
resolveUserInfos
:: (CmdCommon env)
=> UserInfoArgs -> GqlM e env [UserInfo]
resolveUserInfos UserInfoArgs { user_id } = dbUsers user_id
=> AuthenticatedUser
-> AccessPolicyManager
-> UserInfoArgs -> GqlM e env [UserInfo]
resolveUserInfos autUser mgr UserInfoArgs { user_id } =
withPolicy autUser mgr (nodeChecks (NodeId user_id)) $ dbUsers user_id
-- | Mutation for user info
updateUserInfo
:: (CmdCommon env, HasSettings env)
-- => UserInfoMArgs -> ResolverM e (GargM env err) Int
=> UserInfoMArgs -> GqlM' e env err
=> UserInfoMArgs -> GqlM' e env Int
updateUserInfo (UserInfoMArgs { ui_id, .. }) = do
-- lift $ printDebug "[updateUserInfo] ui_id" ui_id
users <- lift (getUsersWithNodeHyperdata (Individu.UserDBId ui_id))
......
......@@ -8,6 +8,7 @@ module Test.API.Private where
import Control.Exception
import Control.Monad
import Control.Monad.Reader
import Data.ByteString (ByteString)
import Data.Maybe
import Data.Proxy
import Fmt
......@@ -16,6 +17,8 @@ import Gargantext.API.Routes
import Gargantext.Core.Types.Individu
import Gargantext.Database.Action.User.New
import Network.HTTP.Client hiding (Proxy)
import Network.HTTP.Types
import Network.Wai.Test (SResponse)
import Prelude
import Servant
import Servant.Auth.Client ()
......@@ -26,14 +29,12 @@ import Test.Database.Types
import Test.Hspec
import Test.Hspec.Wai hiding (pendingWith)
import Test.Hspec.Wai.Internal (withApplication)
import Test.Hspec.Wai.JSON (json)
import Test.Utils (jsonFragment, shouldRespondWith')
import qualified Data.ByteString.Lazy as L
import qualified Data.Text.Encoding as TE
import qualified Network.Wai.Handler.Warp as Wai
import qualified Servant.Auth.Client as SA
import Data.ByteString (ByteString)
import Network.Wai.Test (SResponse)
import Network.HTTP.Types
import qualified Data.ByteString.Lazy as L
import Test.Utils (jsonFragment, shouldRespondWith')
type Env = ((TestEnv, Wai.Port), Application)
......@@ -126,3 +127,20 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
withValidLogin port "alice" (GargPassword "alice") $ \token -> do
protected token "GET" (mkUrl port "/node/1") ""
`shouldRespondWith` 403
describe "GET /api/v1.0/tree" $ do
it "unauthorised users shouldn't see anything" $ \((_testEnv, port), app) -> do
withApplication app $ do
get (mkUrl port "/tree/1") `shouldRespondWith` 401
it "allows 'alice' to see her own node info" $ \((_testEnv, port), app) -> do
withApplication app $ do
withValidLogin port "alice" (GargPassword "alice") $ \token -> do
protected token "GET" (mkUrl port "/tree/8") ""
`shouldRespondWith'` [jsonFragment| { "node": {"id":8, "name":"alice", "type": "NodeUser" } } |]
it "forbids 'alice' to see others node private info" $ \((_testEnv, port), app) -> do
withApplication app $ do
withValidLogin port "alice" (GargPassword "alice") $ \token -> do
protected token "GET" (mkUrl port "/tree/1") ""
`shouldRespondWith` [json| {} |]
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