feat(course-visibility): account for visibility in routes

This commit is contained in:
Sarah Vaupel 2020-07-31 18:05:01 +02:00
parent 4185742f38
commit cb0bf15121
6 changed files with 49 additions and 37 deletions

View File

@ -475,7 +475,8 @@ UnauthorizedParticipant: Angegebener Benutzer ist nicht als Teilnehmer dieser Ve
UnauthorizedParticipantSelf: Sie sind kein Teilnehmer dieser Veranstaltung.
UnauthorizedApplicant: Angegebener Benutzer hat sich nicht für diese Veranstaltung beworben.
UnauthorizedApplicantSelf: Sie sind kein Bewerber für diese Veranstaltung.
UnauthorizedCourseTime: Dieses Kurs erlaubt momentan keine Anmeldungen.
UnauthorizedCourseTime: Dieser Kurs ist momentan nicht freigegeben.
UnauthorizedCourseRegistrationTime: Dieses Kurs erlaubt momentan keine Anmeldungen.
UnauthorizedAllocationRegisterTime: Diese Zentralanmeldung erlaubt momentan keine Bewerbungen.
UnauthorizedSheetTime: Dieses Übungsblatt ist momentan nicht freigegeben.
UnauthorizedApplicationTime: Diese Bewerbung ist momentan nicht freigegeben.
@ -1445,6 +1446,7 @@ AuthTagTutorControl: Tutoren haben Kontrolle über ihre Tutorium
AuthTagTime: Zeitliche Einschränkungen sind erfüllt
AuthTagStaffTime: Zeitliche Einschränkungen für Lehrbeteiligte sind erfüllt
AuthTagAllocationTime: Zeitliche Einschränkungen durch Zentralanmeldung sind erfüllt
AuthTagCourseTime: Zeitliche Einschränkungen für Kurssichtbarkeit sind erfüllt
AuthTagCourseRegistered: Nutzer ist Kursteilnehmer
AuthTagAllocationRegistered: Nutzer nimmt an der Zentralanmeldung teil
AuthTagTutorialRegistered: Nutzer ist Tutoriumsteilnehmer

View File

@ -473,7 +473,8 @@ UnauthorizedParticipant: The specified user is no participant of this course.
UnauthorizedParticipantSelf: You are no participant of this course.
UnauthorizedApplicant: The specified user is no applicant for this course.
UnauthorizedApplicantSelf: You are no applicant for this course.
UnauthorizedCourseTime: This course does not currently allow enrollment.
UnauthorizedCourseTime: This course is not currently available.
UnauthorizedCourseRegistrationTime: This course does not currently allow enrollment.
UnauthorizedAllocationRegisterTime: This central allocation does not currently allow applications.
UnauthorizedSheetTime: This sheet is not currently available.
UnauthorizedApplicationTime: This allocation is not currently available.
@ -1445,6 +1446,7 @@ AuthTagTutorControl: Tutors have control over their tutorial
AuthTagTime: Time restrictions are fulfilled
AuthTagStaffTime: Time restrictions wrt. staff are fulfilled
AuthTagAllocationTime: Time restrictions due to a central allocation are fulfilled
AuthTagCourseTime: Time restrictions wrt. course visibility are fulfilled
AuthTagCourseRegistered: User is enrolled in course
AuthTagAllocationRegistered: User participates in central allocation
AuthTagTutorialRegistered: User is tutorial participant

46
routes
View File

@ -124,10 +124,10 @@
/course/ CourseListR GET !free
!/course/new CourseNewR GET POST !lecturer
/course/#TermId/#SchoolId/#CourseShorthand CourseR !lecturer:
/ CShowR GET !free
/ CShowR GET !tutor !corrector !course-registered !course-time
/favourite CFavouriteR POST
/register CRegisterR GET POST !timeANDcapacityANDallocation-timeAND¬course-registered !timeANDallocation-timeAND¬exam-resultANDcourse-registered !lecturerANDallocation-time
/register-template CRegisterTemplateR GET !free
/register CRegisterR GET POST !timeANDcapacityANDallocation-timeAND¬course-registeredANDcourse-time !timeANDallocation-timeAND¬exam-resultANDcourse-registeredANDcourse-time !lecturerANDallocation-time
/register-template CRegisterTemplateR GET !course-time
/edit CEditR GET POST
/lecturer-invite CLecInviteR GET POST
/delete CDeleteR GET POST !lecturerANDemptyANDallocation-time
@ -141,53 +141,53 @@
/exam-office CExamOfficeR GET POST !course-registered
/subs CCorrectionsR GET POST
/subs/assigned CAssignR GET POST
/sheet SheetListR GET !course-registered !materials !corrector !tutor
/sheet SheetListR GET !course-registered !materialsANDcourse-time !corrector !tutor
/sheet/new SheetNewR GET POST
/sheet/current SheetCurrentR GET !course-registered !materials !corrector !tutor
/sheet/current SheetCurrentR GET !course-registered !materialsANDcourse-time !corrector !tutor
/sheet/unassigned SheetOldUnassignedR GET
/sheet/#SheetName SheetR:
/show SShowR GET !timeANDcourse-registered !timeANDmaterials !corrector !timeANDtutor
/show/download SArchiveR GET !timeANDcourse-registeredANDexam-registered !timeANDmaterialsANDexam-registered !corrector !timeANDtutor
/show SShowR GET !timeANDcourse-registered !timeANDmaterialsANDcourse-time !corrector !timeANDtutor
/show/download SArchiveR GET !timeANDcourse-registeredANDexam-registered !timeANDmaterialsANDexam-registeredANDcourse-time !corrector !timeANDtutor
/edit SEditR GET POST
/delete SDelR GET POST
/subs SSubsR GET POST -- for lecturer only
!/subs/new SubmissionNewR GET POST !timeANDcourse-registeredANDuser-submissionsANDsubmission-groupANDexam-registered
!/subs/own SubmissionOwnR GET !free -- just redirect
!/subs/own SubmissionOwnR GET !course-time -- just redirect
!/subs/assign SAssignR GET POST !lecturerANDtime
/subs/#CryptoFileNameSubmission SubmissionR:
/ SubShowR GET POST !ownerANDtimeANDuser-submissionsANDsubmission-groupANDexam-registered !ownerANDread !correctorANDread
/delete SubDelR GET POST !ownerANDtimeANDuser-submissionsANDexam-registered
/ SubShowR GET POST !ownerANDtimeANDuser-submissionsANDsubmission-groupANDexam-registeredANDcourse-time !ownerANDreadANDcourse-time !correctorANDread
/delete SubDelR GET POST !ownerANDtimeANDuser-submissionsANDexam-registeredANDcourse-time
/assign SubAssignR GET POST !lecturerANDtime
/correction CorrectionR GET POST !corrector !ownerANDreadANDrated
/invite SInviteR GET POST !ownerANDtimeANDuser-submissionsANDsubmission-groupANDexam-registered
!/#SubmissionFileType SubArchiveR GET !owner !corrector
!/#SubmissionFileType/*FilePath SubDownloadR GET !owner !corrector
/correction CorrectionR GET POST !corrector !ownerANDreadANDratedANDcourse-time
/invite SInviteR GET POST !ownerANDtimeANDuser-submissionsANDsubmission-groupANDexam-registeredANDcourse-time
!/#SubmissionFileType SubArchiveR GET !ownerANDcourse-time !corrector
!/#SubmissionFileType/*FilePath SubDownloadR GET !ownerANDcourse-time !corrector
/iscorrector SIsCorrR GET !corrector -- Route is used to check for corrector access to this sheet
/pseudonym SPseudonymR GET POST !course-registeredANDcorrector-submissionsANDexam-registered
/corrector-invite/ SCorrInviteR GET POST
!/#SheetFileType SZipR GET !timeANDcourse-registeredANDexam-registered !timeANDmaterialsANDexam-registered !corrector !timeANDtutor
!/#SheetFileType/*FilePath SFileR GET !timeANDcourse-registeredANDexam-registered !timeANDmaterialsANDexam-registered !corrector !timeANDtutor
/file MaterialListR GET !course-registered !materials !corrector !tutor
/file MaterialListR GET !course-registered !materialsANDcourse-time !corrector !tutor
/file/new MaterialNewR GET POST
/file/#MaterialName MaterialR:
/edit MEditR GET POST
/delete MDelR GET POST
/show MShowR GET !timeANDcourse-registered !timeANDmaterials !corrector !tutor
!/download MArchiveR GET !timeANDcourse-registered !timeANDmaterials !corrector !tutor
!/download/*FilePath MFileR GET !timeANDcourse-registered !timeANDmaterials !corrector !tutor
/show MShowR GET !timeANDcourse-registered !timeANDmaterialsANDcourse-time !corrector !tutor
!/download MArchiveR GET !timeANDcourse-registered !timeANDmaterialsANDcourse-time !corrector !tutor
!/download/*FilePath MFileR GET !timeANDcourse-registered !timeANDmaterialsANDcourse-time !corrector !tutor
/tuts CTutorialListR GET !tutor -- THIS route is used to check for overall course tutor access!
/tuts/new CTutorialNewR GET POST
/tuts/#TutorialName TutorialR:
/edit TEditR GET POST !tutorANDtutor-control
/delete TDeleteR GET POST
/participants TUsersR GET POST !tutor
/register TRegisterR POST !timeANDcapacityANDcourse-registeredANDregister-group !timeANDtutorial-registered
/register TRegisterR POST !timeANDcapacityANDcourse-registeredANDregister-group !timeANDtutorial-registeredANDcourse-time
/communication TCommR GET POST !tutor
/tutor-invite TInviteR GET POST !tutorANDtutor-control
/exams CExamListR GET !free
/exams CExamListR GET !tutor !corrector !course-registered !course-time
/exams/new CExamNewR GET POST
/exams/#ExamName ExamR:
/show EShowR GET !time !exam-office
/show EShowR GET !timeANDtutor !timeANDcorrector !timeANDcourse-registered !timeANDcourse-time !exam-office
/edit EEditR GET POST
/corrector-invite ECInviteR GET POST
/users EUsersR GET POST
@ -201,8 +201,8 @@
/apps CApplicationsR GET POST
!/apps/files CAppsFilesR GET
/apps/#CryptoFileNameCourseApplication CourseApplicationR:
/ CAEditR GET POST !timeANDself !lecturerANDstaff-time !selfANDread
/files CAFilesR GET !self !lecturerANDstaff-time
/ CAEditR GET POST !timeANDselfANDcourse-time !lecturerANDstaff-time !selfANDreadANDcourse-time
/files CAFilesR GET !selfANDcourse-time !lecturerANDstaff-time
!/news/add CNewsNewR GET POST
/news/#CryptoUUIDCourseNews CourseNewsR:
/ CNShowR GET !timeANDparticipant

View File

@ -74,6 +74,7 @@ import Handler.Utils.ExamOffice.Course
import Handler.Utils.Profile
import Handler.Utils.Routes
import Handler.Utils.Memcached
import Utils.Course (courseIsVisible')
import Utils.Form
import Utils.Sheet
import Utils.SystemMessage
@ -842,7 +843,7 @@ tagAccessPredicate AuthTime = APDB $ \mAuthId route _ -> case route of
, maybe True (now <=) courseRegisterTo -> return Authorized
(Just (Entity cid Course{courseDeregisterUntil}))
| registered
-> maybeT (unauthorizedI MsgUnauthorizedCourseTime) $ do
-> maybeT (unauthorizedI MsgUnauthorizedCourseRegistrationTime) $ do
guard $ maybe True (now <=) courseDeregisterUntil
forM_ mAuthId $ \uid -> do
exams <- lift . E.select . E.from $ \exam -> do
@ -863,7 +864,7 @@ tagAccessPredicate AuthTime = APDB $ \mAuthId route _ -> case route of
forM_ tutorials $ \(E.Value deregUntil) ->
guard $ NTop (Just now) <= NTop deregUntil
return Authorized
_other -> unauthorizedI MsgUnauthorizedCourseTime
_other -> unauthorizedI MsgUnauthorizedCourseRegistrationTime
CApplicationR tid ssh csh _ _ -> maybeT (unauthorizedI MsgUnauthorizedApplicationTime) $ do
Entity course Course{..} <- $cachedHereBinary (tid, ssh, csh) . MaybeT . getBy $ TermSchoolCourseShort tid ssh csh
@ -985,6 +986,13 @@ tagAccessPredicate AuthAllocationTime = APDB $ \mAuthId route _ -> case route of
cid <- MaybeT . getKeyBy $ TermSchoolCourseShort tid ssh csh
Entity _ AllocationCourse{..} <- MaybeT . getBy $ UniqueAllocationCourse cid
(cid,) <$> MaybeT (get allocationCourseAllocation)
tagAccessPredicate AuthCourseTime = APDB $ \_mAuthId route _ -> case route of
CourseR tid ssh csh _ -> maybeT (unauthorizedI MsgUnauthorizedCourseTime) $ do
now <- liftIO getCurrentTime
Entity _cid course <- $cachedHereBinary (tid, ssh, csh) . MaybeT . getBy $ TermSchoolCourseShort tid ssh csh
guard $ courseIsVisible' now course
return Authorized
r -> $unsupportedAuthPredicate AuthCourseTime r
tagAccessPredicate AuthCourseRegistered = APDB $ \mAuthId route _ -> case route of
CourseR tid ssh csh _ -> exceptT return return $ do
authId <- maybeExceptT AuthenticationRequired $ return mAuthId
@ -1476,7 +1484,7 @@ authTagSpecificity = comparing $ NTop . flip findIndex eqClasses . elem
[ [ AuthFree, AuthDeprecated, AuthDevelopment ] -- Route wide
, [ AuthRead, AuthWrite, AuthToken ] -- Request wide
, [ AuthAdmin ] -- Site wide
, [ AuthLecturer, AuthCourseRegistered, AuthParticipant, AuthTime, AuthMaterials, AuthUserSubmissions, AuthCorrectorSubmissions, AuthCapacity, AuthEmpty ] ++ [ AuthSelf, AuthNoEscalation ] ++ [ AuthAuthentication ] -- Course/User/SystemMessage wide
, [ AuthLecturer, AuthCourseRegistered, AuthParticipant, AuthCourseTime, AuthTime, AuthMaterials, AuthUserSubmissions, AuthCorrectorSubmissions, AuthCapacity, AuthEmpty ] ++ [ AuthSelf, AuthNoEscalation ] ++ [ AuthAuthentication ] -- Course/User/SystemMessage wide
, [ AuthCorrector ] ++ [ AuthTutor ] ++ [ AuthTutorialRegistered, AuthRegisterGroup ] -- Tutorial/Material/Sheet wide
, [ AuthOwner, AuthRated ] -- Submission wide
]
@ -2026,13 +2034,13 @@ siteLayout' headingOverride widget = do
return (course, reason, isAssociated)
favCourses' <- forM favCourses'' $ \(course@(Entity _ Course{..}), reason, isAssociated) -> do
mayEditCourse <- hasWriteAccessTo $ CourseR courseTerm courseSchool courseShorthand CEditR
return (course, reason, isAssociated, mayEditCourse)
mayEdit <- hasWriteAccessTo $ CourseR courseTerm courseSchool courseShorthand CEditR
return (course, reason, isAssociated, mayEdit)
-- remove invisible courses
let favCourses = favCourses'
& filter (\(Entity _ Course{..}, _, E.Value isAssociated, mayEditCourse) -> mayEditCourse || isAssociated || NTop courseVisibleFrom <= NTop (Just now) && NTop (Just now) <= NTop courseVisibleTo)
& map (\(course, reason, _, mayEditCourse) -> (course, reason, mayEditCourse))
& filter (\(Entity _ Course{..}, _, E.Value isAssociated, mayEdit) -> mayEdit || isAssociated || NTop courseVisibleFrom <= NTop (Just now) && NTop (Just now) <= NTop courseVisibleTo)
& map (\(course, reason, _, mayEdit) -> (course, reason, mayEdit))
return ( favCourses
, maybe userDefaultMaxFavouriteTerms userMaxFavouriteTerms $ view _2 <$> muid
@ -2042,7 +2050,7 @@ siteLayout' headingOverride widget = do
let favouriteTerms :: [TermIdentifier]
favouriteTerms = take maxFavouriteTerms . Set.toDescList $ foldMap (\(Entity _ Course{..}, _, _) -> Set.singleton $ unTermKey courseTerm) favourites'
favourites <- fmap catMaybes . forM favourites' $ \(Entity cId c@Course{..}, E.Value mFavourite, mayEditCourse)
favourites <- fmap catMaybes . forM favourites' $ \(Entity cId c@Course{..}, E.Value mFavourite, mayEdit)
-> let courseRoute = CourseR courseTerm courseSchool courseShorthand CShowR
favouriteReason = fromMaybe FavouriteCurrent mFavourite
in runMaybeT . guardOnM (unTermKey courseTerm `elem` favouriteTerms) . lift $ do
@ -2064,7 +2072,7 @@ siteLayout' headingOverride widget = do
$logDebugS "FavouriteQuickActions" $ tshow cK <> " Done."
return items
$logDebugS "FavouriteQuickActions" $ tshow cK <> " returning " <> tshow (is _Just items)
return (c, courseRoute, items, favouriteReason, mayEditCourse)
return (c, courseRoute, items, favouriteReason, mayEdit)
nav'' <- mconcat <$> sequence
[ defaultLinks
@ -2200,7 +2208,6 @@ siteLayout' headingOverride widget = do
asidenav = $(widgetFile "widgets/asidenav/asidenav")
where
logo = preEscapedToMarkup $ decodeUtf8 $(embedFile "assets/lmu/logo.svg")
courseIsVisible Course{courseVisibleFrom,courseVisibleTo} = NTop courseVisibleFrom <= NTop (Just now) && NTop (Just now) <= NTop courseVisibleTo
footer :: Widget
footer = $(widgetFile "widgets/footer/footer")
where isNavFooter = has $ _1 . _NavFooter

View File

@ -66,6 +66,7 @@ data AuthTag -- sortiert nach gewünschter Reihenfolge auf /authpreds, d.h. Prä
| AuthTime
| AuthStaffTime
| AuthAllocationTime
| AuthCourseTime
| AuthMaterials
| AuthOwner
| AuthRated

View File

@ -21,13 +21,13 @@ $newline never
<h3 .asidenav__box-subtitle>
_{favReason}
<ul .asidenav__list.list--iconless>
$forall (course@Course{courseShorthand, courseName}, courseRoute, mPageActions, _, mayEditCourse) <- favouriteTermReason tid favReason
$forall (course@Course{courseShorthand, courseName}, courseRoute, mPageActions, _, mayEdit) <- favouriteTermReason tid favReason
<li .asidenav__list-item :highlight courseRoute:.asidenav__list-item--active>
<a .asidenav__link-wrapper href=@{courseRoute}>
<div .asidenav__link-shorthand>#{courseShorthand}
<div .asidenav__link-label>
#{courseName}
$if not (courseIsVisible course) && mayEditCourse
$if mayEdit && not (courseIsVisible' now course)
\ #{iconInvisible}
<div .asidenav__nested-list-wrapper>
$maybe pageActions <- mPageActions