From 20c0e40638ed0f3deb1c20faa3de14493f6bbdb3 Mon Sep 17 00:00:00 2001 From: fr33domlover Date: Sat, 26 Jan 2019 22:22:49 +0000 Subject: [PATCH] Determine operation access in Vervis.Access, reuse it everywhere it's needed --- src/Vervis/Access.hs | 161 +++++++++++++++++++++++++++++++++++++++ src/Vervis/Foundation.hs | 32 +++----- src/Vervis/Query.hs | 46 +++++++++-- src/Vervis/Ssh.hs | 18 ++--- vervis.cabal | 1 + 5 files changed, 218 insertions(+), 40 deletions(-) create mode 100644 src/Vervis/Access.hs diff --git a/src/Vervis/Access.hs b/src/Vervis/Access.hs new file mode 100644 index 0000000..a36f688 --- /dev/null +++ b/src/Vervis/Access.hs @@ -0,0 +1,161 @@ +{- This file is part of Vervis. + - + - Written in 2019 by fr33domlover . + - + - ♡ Copying is an act of love. Please copy, reuse and share. + - + - The author(s) have dedicated all copyright and related and neighboring + - rights to this software to the public domain worldwide. This software is + - distributed without any warranty. + - + - You should have received a copy of the CC0 Public Domain Dedication along + - with this software. If not, see + - . + -} + +-- | In this module I'd like to collect all the operation access checks. When a +-- given user asks to perform a certain operation, do we accept the request and +-- perform the changes to our database etc.? The functions here should provide +-- the answer. +-- +-- Vervis uses a role-based access control system (RBAC) with role inheritance. +-- In order to determine access to a given operation, conceptually the +-- following two steps happen: +-- +-- (1) Determine the actor's role +-- (2) Determine whether that role has access to the operation +-- +-- There are 3 mechanisms for assigning a role to actors: +-- +-- (1) Local: +-- A given project or repo may keep a list of users on the same server. +-- to which they are assigning roles. +-- (2) Capability: +-- For users from other instances, we provide signed capability +-- documents when they get assigned a role, and we verify them when the +-- user requests to perform an operation. We keep a token for each +-- capability we grant, so that we can revoke it, and so that we can +-- have a list of remote project/repo members. +-- (3) Public: +-- If an actor doesn't have a role through one of the previous twp +-- methods, we may still assign a role to them using automatic +-- assignment. It's called _Public_ because it's generally meant for +-- assigning to the general public, people who aren't listed in our +-- role assignment lists, and to give public access to resources. A +-- project or repo may define a role to be assigned automatically +-- depending on the status of the actor. For example, assign a certain +-- role if it's a local logged-in user, or if it's an anonymous +-- not-logged-in client POSTing some operation, or if it's a remote +-- user from another instance, verified with a valid signature approved +-- by their server. +-- +-- Conceptually, the default if none of these methods assign a role, is to +-- assume a "null role" i.e. a hypothetical role that can't access any +-- operations. +module Vervis.Access + ( ObjectAccessStatus (..) + , checkRepoAccess + , checkProjectAccess + ) +where + +import Prelude + +import Control.Applicative ((<|>)) +import Control.Monad.IO.Class +import Control.Monad.Trans.Maybe +import Control.Monad.Trans.Reader +import Database.Persist.Class (getBy) +import Database.Persist.Sql (SqlBackend) +import Database.Persist.Types (Entity (..)) + +import Vervis.Model +import Vervis.Model.Ident +import Vervis.Model.Role +import Vervis.Query + +data ObjectAccessStatus = + NoSuchObject | ObjectAccessDenied | ObjectAccessAllowed + deriving Eq + +checkRepoAccess + :: MonadIO m + => Maybe PersonId + -> RepoOperation + -> ShrIdent + -> RpIdent + -> ReaderT SqlBackend m ObjectAccessStatus +checkRepoAccess mpid op shr rp = do + mrid <- runMaybeT $ do + Entity sid _sharer <- MaybeT $ getBy $ UniqueSharer shr + Entity rid _repo <- MaybeT $ getBy $ UniqueRepo rp sid + return rid + case mrid of + Nothing -> return NoSuchObject + Just rid -> do + mra <- runMaybeT $ do + rlid <- do + case mpid of + Just pid -> + MaybeT (asCollab rid pid) + <|> MaybeT (asUser rid) + <|> MaybeT (asAnon rid) + Nothing -> MaybeT $ asAnon rid + MaybeT (roleHas rlid op) <|> MaybeT (ancestorHas rlid op) + return $ + case mra of + Nothing -> ObjectAccessDenied + Just _ -> ObjectAccessAllowed + where + asCollab rid pid = + fmap (repoCollabRole . entityVal) <$> + getBy (UniqueRepoCollab rid pid) + asUser rid = + fmap (repoCollabUserRole . entityVal) <$> + getBy (UniqueRepoCollabUser rid) + asAnon rid = + fmap (repoCollabAnonRole . entityVal) <$> + getBy (UniqueRepoCollabAnon rid) + roleHas role operation = getBy $ UniqueRepoAccess role operation + ancestorHas = flip getRepoRoleAncestorWithOpQ + +checkProjectAccess + :: MonadIO m + => Maybe PersonId + -> ProjectOperation + -> ShrIdent + -> PrjIdent + -> ReaderT SqlBackend m ObjectAccessStatus +checkProjectAccess mpid op shr prj = do + mjid <- runMaybeT $ do + Entity sid _sharer <- MaybeT $ getBy $ UniqueSharer shr + Entity jid _project <- MaybeT $ getBy $ UniqueProject prj sid + return jid + case mjid of + Nothing -> return NoSuchObject + Just jid -> do + mpa <- runMaybeT $ do + rlid <- do + case mpid of + Just pid -> + MaybeT (asCollab jid pid) + <|> MaybeT (asUser jid) + <|> MaybeT (asAnon jid) + Nothing -> MaybeT $ asAnon jid + MaybeT (roleHas rlid op) <|> MaybeT (ancestorHas rlid op) + return $ + case mpa of + Nothing -> ObjectAccessDenied + Just _ -> ObjectAccessAllowed + where + asCollab jid pid = + fmap (projectCollabRole . entityVal) <$> + getBy (UniqueProjectCollab jid pid) + asUser jid = + fmap (projectCollabUserRole . entityVal) <$> + getBy (UniqueProjectCollabUser jid) + asAnon jid = + fmap (projectCollabAnonRole . entityVal) <$> + getBy (UniqueProjectCollabAnon jid) + roleHas role operation = getBy $ UniqueProjectAccess role operation + ancestorHas = flip getProjectRoleAncestorWithOpQ diff --git a/src/Vervis/Foundation.hs b/src/Vervis/Foundation.hs index 9ac8fc1..315ce2c 100644 --- a/src/Vervis/Foundation.hs +++ b/src/Vervis/Foundation.hs @@ -60,12 +60,12 @@ import Web.ActivityPub import Text.Email.Local import Text.Jasmine.Local (discardm) +import Vervis.Access import Vervis.ActorKey (ActorKey) import Vervis.Import.NoFoundation hiding (Handler, Day, last, init, logWarn) import Vervis.Model.Group import Vervis.Model.Ident import Vervis.Model.Role -import Vervis.Query (getProjectRoleAncestorWithOpQ) import Vervis.Widget (breadcrumbsW, revisionW) -- | The foundation datatype for your application. This can be a good place to @@ -365,27 +365,15 @@ instance Yesod App where projOp :: ProjectOperation -> ShrIdent -> PrjIdent -> Handler AuthResult - projOp op shr prj = personAnd $ \ (Entity pid _p) -> do - ma <- runDB $ runMaybeT $ do - Entity sid _s <- MaybeT $ getBy $ UniqueSharer shr - Entity jid _j <- MaybeT $ getBy $ UniqueProject prj sid - let asCollab = do - Entity _cid c <- - MaybeT $ getBy $ UniqueProjectCollab jid pid - return $ projectCollabRole c - asUser = do - Entity _cuid cu <- - MaybeT $ getBy $ UniqueProjectCollabUser jid - return $ projectCollabUserRole cu - role <- asCollab <|> asUser - let roleHas = getBy $ UniqueProjectAccess role op - ancestorHas = getProjectRoleAncestorWithOpQ op role - MaybeT roleHas <|> MaybeT ancestorHas - return $ case ma of - Nothing -> - Unauthorized - "You need a project role with that operation enabled" - Just _ -> Authorized + projOp op shr prj = do + mpid <- maybeAuthId + oas <- runDB $ checkProjectAccess mpid op shr prj + return $ + case oas of + ObjectAccessAllowed -> Authorized + _ -> + Unauthorized + "You need a project role with that operation enabled" -- This function creates static content files in the static folder -- and names them based on a hash of their content. This allows diff --git a/src/Vervis/Query.hs b/src/Vervis/Query.hs index 6c1e95e..e41d5fa 100644 --- a/src/Vervis/Query.hs +++ b/src/Vervis/Query.hs @@ -18,7 +18,8 @@ -- helps identify patterns and commonly needed but missing tools, which can -- then be implemented and simplify the queries. module Vervis.Query - ( getProjectRoleAncestorWithOpQ + ( getRepoRoleAncestorWithOpQ + , getProjectRoleAncestorWithOpQ ) where @@ -40,11 +41,44 @@ import Database.Persist.Graph.SQL import Vervis.Model import Vervis.Model.Role --- utils to place in a common module: --- --- * dummyFrom* --- * eEdge ^* ProjectRoleInheritParent --- * x ^* y ==* z ^* w +-- | Given a repo role and a repo operation, find an ancestor role which +-- has access to the operation. +getRepoRoleAncestorWithOpQ + :: MonadIO m + => RepoOperation + -> RepoRoleId + -> ReaderT SqlBackend m (Maybe (Entity RepoAccess)) +getRepoRoleAncestorWithOpQ op role = do + conn <- ask + let dbname = connEscapeName conn + eAcc = entityDef $ dummyFromField RepoAccessId + tAcc = dbname $ entityDB eAcc + qcols = + T.intercalate ", " $ + map ((tAcc <>) . ("." <>)) $ + entityColumnNames eAcc conn + field :: PersistEntity record => EntityField record typ -> Text + field = dbname . fieldDB . persistFieldDef + listToMaybe <$> + rawSqlWithGraph + Ancestors + role + RepoRoleInheritParent + RepoRoleInheritChild + (\ temp -> mconcat + [ "SELECT ??" + , " FROM ", dbname temp, " INNER JOIN ", tAcc + , " ON " + , dbname temp, ".", field RepoRoleInheritParent + , " = " + , tAcc, ".", field RepoAccessRole + , " WHERE " + , tAcc, ".", field RepoAccessOp + , " = ?" + , " LIMIT 1" + ] + ) + [toPersistValue op] -- | Given a project role and a project operation, find an ancestor role which -- has access to the operation. diff --git a/src/Vervis/Ssh.hs b/src/Vervis/Ssh.hs index f1b7957..e137182 100644 --- a/src/Vervis/Ssh.hs +++ b/src/Vervis/Ssh.hs @@ -50,6 +50,7 @@ import System.Process (CreateProcess (..), StdStream (..), createProcess, proc) import qualified Data.Text as T import qualified Formatting as F +import Vervis.Access import Vervis.Model import Vervis.Model.Ident import Vervis.Model.Role @@ -232,18 +233,11 @@ whenGitRepoExists = whenRepoExists "Git" $ isRepo . fromString canPushTo :: ShrIdent -> RpIdent -> Channel Bool canPushTo shr rp = do pid <- authId <$> askAuthDetails - ma <- runChanDB $ runMaybeT $ do - Entity sid _sharer <- MaybeT $ getBy $ UniqueSharer shr - Entity rid _repo <- MaybeT $ getBy $ UniqueRepo rp sid - let asCollab = do - Entity _ c <- MaybeT $ getBy $ UniqueRepoCollab rid pid - return $ repoCollabRole c - asUser = do - Entity _ cu <- MaybeT $ getBy $ UniqueRepoCollabUser rid - return $ repoCollabUserRole cu - role <- asCollab <|> asUser - MaybeT $ getBy $ UniqueRepoAccess role RepoOpPush - return $ isJust ma + oas <- runChanDB $ checkRepoAccess (Just pid) RepoOpPush shr rp + return $ + case oas of + ObjectAccessAllowed -> True + _ -> False runAction :: FilePath -> Bool -> Action -> Channel ActionResult runAction repoDir _wantReply action = diff --git a/vervis.cabal b/vervis.cabal index 86dd9e6..8ae18bb 100644 --- a/vervis.cabal +++ b/vervis.cabal @@ -89,6 +89,7 @@ library Yesod.Paginate.Local Yesod.SessionEntity + Vervis.Access Vervis.ActivityStreams Vervis.ActorKey Vervis.Application