fraport/fradrive
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fix(course-visibility): visibility for admin-like users

Browse Source
This commit is contained in:
Sarah Vaupel 2020-08-06 19:46:15 +02:00
parent 7bdf8cac88
commit 43f625ba0c
1 changed files with 19 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
src/Foundation.hs
View File

@ -533,6 +533,15 @@ tagAccessPredicate AuthExamOffice = APDB $ \mAuthId route _ -> case route of
E.where_ $ examOfficeExternalExamResultAuth (E.val authId) eexamResult
guardMExceptT hasUsers $ unauthorizedI MsgUnauthorizedExternalExamExamOffice
return Authorized
CourseR _ ssh _ _ -> $cachedHereBinary (mAuthId, ssh) . exceptT return return $ do
authId <- maybeExceptT AuthenticationRequired $ return mAuthId
isExamOffice <- lift $ exists
[ UserFunctionUser ==. authId
, UserFunctionFunction ==. SchoolExamOffice
, UserFunctionSchool ==. ssh
]
guardMExceptT isExamOffice $ unauthorizedI MsgUnauthorizedExamExamOffice
return Authorized
_other -> $cachedHereBinary mAuthId . exceptT return return $ do
authId <- maybeExceptT AuthenticationRequired $ return mAuthId
isExamOffice <- lift $ exists [UserFunctionUser ==. authId, UserFunctionFunction ==. SchoolExamOffice]
@ -544,6 +553,11 @@ tagAccessPredicate AuthEvaluation = APDB $ \mAuthId route _ -> case route of
isEvaluation <- lift . existsBy $ UniqueUserFunction authId ssh SchoolEvaluation
guardMExceptT isEvaluation $ unauthorizedI MsgUnauthorizedEvaluation
return Authorized
CourseR _ ssh _ _ -> $cachedHereBinary(mAuthId, ssh) . exceptT return return $ do
authId <- maybeExceptT AuthenticationRequired $ return mAuthId
isEvaluation <- lift . existsBy $ UniqueUserFunction authId ssh SchoolEvaluation
guardMExceptT isEvaluation $ unauthorizedI MsgUnauthorizedEvaluation
return Authorized
_other -> $cachedHereBinary mAuthId . exceptT return return $ do
authId <- maybeExceptT AuthenticationRequired $ return mAuthId
isEvaluation <- lift $ exists [UserFunctionUser ==. authId, UserFunctionFunction ==. SchoolEvaluation]
@ -555,6 +569,11 @@ tagAccessPredicate AuthAllocationAdmin = APDB $ \mAuthId route _ -> case route o
isEvaluation <- lift . existsBy $ UniqueUserFunction authId ssh SchoolAllocation
guardMExceptT isEvaluation $ unauthorizedI MsgUnauthorizedAllocationAdmin
return Authorized
CourseR _ ssh _ _ -> $cachedHereBinary (mAuthId, ssh) . exceptT return return $ do
authId <- maybeExceptT AuthenticationRequired $ return mAuthId
isEvaluation <- lift . existsBy $ UniqueUserFunction authId ssh SchoolAllocation
guardMExceptT isEvaluation $ unauthorizedI MsgUnauthorizedAllocationAdmin
return Authorized
_other -> $cachedHereBinary mAuthId . exceptT return return $ do
authId <- maybeExceptT AuthenticationRequired $ return mAuthId
isEvaluation <- lift $ exists [UserFunctionUser ==. authId, UserFunctionFunction ==. SchoolAllocation]