fix(course-visibility): visibility for admin-like users
This commit is contained in:
parent
7bdf8cac88
commit
43f625ba0c
@ -533,6 +533,15 @@ tagAccessPredicate AuthExamOffice = APDB $ \mAuthId route _ -> case route of
|
|||||||
E.where_ $ examOfficeExternalExamResultAuth (E.val authId) eexamResult
|
E.where_ $ examOfficeExternalExamResultAuth (E.val authId) eexamResult
|
||||||
guardMExceptT hasUsers $ unauthorizedI MsgUnauthorizedExternalExamExamOffice
|
guardMExceptT hasUsers $ unauthorizedI MsgUnauthorizedExternalExamExamOffice
|
||||||
return Authorized
|
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
|
_other -> $cachedHereBinary mAuthId . exceptT return return $ do
|
||||||
authId <- maybeExceptT AuthenticationRequired $ return mAuthId
|
authId <- maybeExceptT AuthenticationRequired $ return mAuthId
|
||||||
isExamOffice <- lift $ exists [UserFunctionUser ==. authId, UserFunctionFunction ==. SchoolExamOffice]
|
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
|
isEvaluation <- lift . existsBy $ UniqueUserFunction authId ssh SchoolEvaluation
|
||||||
guardMExceptT isEvaluation $ unauthorizedI MsgUnauthorizedEvaluation
|
guardMExceptT isEvaluation $ unauthorizedI MsgUnauthorizedEvaluation
|
||||||
return Authorized
|
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
|
_other -> $cachedHereBinary mAuthId . exceptT return return $ do
|
||||||
authId <- maybeExceptT AuthenticationRequired $ return mAuthId
|
authId <- maybeExceptT AuthenticationRequired $ return mAuthId
|
||||||
isEvaluation <- lift $ exists [UserFunctionUser ==. authId, UserFunctionFunction ==. SchoolEvaluation]
|
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
|
isEvaluation <- lift . existsBy $ UniqueUserFunction authId ssh SchoolAllocation
|
||||||
guardMExceptT isEvaluation $ unauthorizedI MsgUnauthorizedAllocationAdmin
|
guardMExceptT isEvaluation $ unauthorizedI MsgUnauthorizedAllocationAdmin
|
||||||
return Authorized
|
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
|
_other -> $cachedHereBinary mAuthId . exceptT return return $ do
|
||||||
authId <- maybeExceptT AuthenticationRequired $ return mAuthId
|
authId <- maybeExceptT AuthenticationRequired $ return mAuthId
|
||||||
isEvaluation <- lift $ exists [UserFunctionUser ==. authId, UserFunctionFunction ==. SchoolAllocation]
|
isEvaluation <- lift $ exists [UserFunctionUser ==. authId, UserFunctionFunction ==. SchoolAllocation]
|
||||||
|
|||||||
Reference in New Issue
Block a user