Prevent admins elevating rights to more schools by session-hijacking
This commit is contained in:
parent
dc03afa84d
commit
a02e2cdc98
1
models
1
models
@ -12,6 +12,7 @@ User json
|
|||||||
UserAdmin
|
UserAdmin
|
||||||
user UserId
|
user UserId
|
||||||
school SchoolId
|
school SchoolId
|
||||||
|
UniqueUserAdmin user school
|
||||||
UserLecturer
|
UserLecturer
|
||||||
user UserId
|
user UserId
|
||||||
school SchoolId
|
school SchoolId
|
||||||
|
|||||||
@ -13,6 +13,7 @@ import Import
|
|||||||
import Handler.Utils
|
import Handler.Utils
|
||||||
|
|
||||||
import qualified Data.Map as Map
|
import qualified Data.Map as Map
|
||||||
|
import qualified Data.Set as Set
|
||||||
|
|
||||||
import qualified Database.Esqueleto as E
|
import qualified Database.Esqueleto as E
|
||||||
|
|
||||||
@ -95,7 +96,15 @@ postAdminHijackUserR cID = do
|
|||||||
case hijackRes of
|
case hijackRes of
|
||||||
FormSuccess uid'
|
FormSuccess uid'
|
||||||
| uid' == uid -> do
|
| uid' == uid -> do
|
||||||
User{..} <- runDB $ get404 uid
|
myUid <- requireAuthId
|
||||||
|
User{..} <- runDB $ do
|
||||||
|
otherSchoolsAdmin <- Set.fromList . map (userAdminSchool . entityVal) <$> selectList [UserAdminUser ==. uid] []
|
||||||
|
otherSchoolsLecturer <- Set.fromList . map (userLecturerSchool . entityVal) <$> selectList [UserLecturerUser ==. uid] []
|
||||||
|
mySchools <- Set.fromList . map (userAdminSchool . entityVal) <$> selectList [UserAdminUser ==. myUid] []
|
||||||
|
when (not $ (otherSchoolsAdmin `Set.union` otherSchoolsLecturer) `Set.isSubsetOf` mySchools) $
|
||||||
|
permissionDenied "Cannot escalate admin status to additional schools"
|
||||||
|
|
||||||
|
get404 uid
|
||||||
setCredsRedirect $ Creds "dummy" (userPlugin <> ":" <> userIdent) []
|
setCredsRedirect $ Creds "dummy" (userPlugin <> ":" <> userIdent) []
|
||||||
| otherwise -> error "This should be impossible by definition of `hijackUserForm`"
|
| otherwise -> error "This should be impossible by definition of `hijackUserForm`"
|
||||||
FormFailure errs -> toTypedContent <$> mapM_ (addMessage "error" . toHtml) errs
|
FormFailure errs -> toTypedContent <$> mapM_ (addMessage "error" . toHtml) errs
|
||||||
|
|||||||
Reference in New Issue
Block a user