fraport/fradrive-old
fraport/fradrive-old
Archived
3
1
Fork 0
Code Issues 65 Pull Requests 5 Actions Packages Projects Releases 197 Wiki Activity

fix(schedule): make course schedule opt-ins work for unregistered users

Browse Source
This commit is contained in:
Sarah Vaupel 2020-11-09 19:27:20 +01:00
parent 42c133d3ed
commit 1d34cae4e2
1 changed files with 43 additions and 39 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

82
src/Utils/Schedule.hs
View File

@ -21,51 +21,27 @@ fetchActiveTerms = E.select $ E.from $ \term -> do
fetchCourseEvents :: MonadHandler m => Maybe UserId -> AuthTagActive -> UTCTime -> ReaderT SqlBackend m [ScheduleCourseEventInfo]
fetchCourseEvents muid ata now = E.select $ E.from $ \(course `E.InnerJoin` courseEvent) -> do
E.on $ course E.^. CourseId E.==. courseEvent E.^. CourseEventCourse
E.where_ $ courseEventShouldBeDisplayed muid course courseEvent
E.where_ $ courseEventShouldBeDisplayed muid ata course courseEvent
E.&&. mayViewCourse muid ata now course Nothing -- should not be necessary, but let's be on the safe side
E.&&. ( isCourseParticipant muid ata (course E.^. CourseId)
E.||. isCourseLecturer muid ata (course E.^. CourseId)
)
return (course, courseEvent)
fetchTutorials :: MonadHandler m => Maybe UserId -> AuthTagActive -> UTCTime -> ReaderT SqlBackend m [ScheduleTutorialInfo]
fetchTutorials muid ata now = E.select $ E.from $ \(course `E.InnerJoin` tutorial) -> do
E.on $ course E.^. CourseId E.==. tutorial E.^. TutorialCourse
E.where_ $ tutorialShouldBeDisplayed muid course tutorial
E.where_ $ tutorialShouldBeDisplayed muid ata course tutorial
E.&&. mayViewCourse muid ata now course Nothing -- should not be necessary, but let's be on the safe side
E.&&. ( isTutorialTutor muid ata (tutorial E.^. TutorialId)
E.||. isTutorialParticipant muid ata (tutorial E.^. TutorialId)
)
return (course, tutorial)
fetchExamOccurrences :: MonadHandler m => Maybe UserId -> AuthTagActive -> UTCTime -> ReaderT SqlBackend m [ScheduleExamOccurrenceInfo]
fetchExamOccurrences muid ata now = E.select $ E.from $ \(course `E.InnerJoin` exam `E.InnerJoin` examOccurrence) -> do
E.on $ course E.^. CourseId E.==. exam E.^. ExamCourse
E.on $ exam E.^. ExamId E.==. examOccurrence E.^. ExamOccurrenceExam
E.where_ $ examOccurrenceShouldBeDisplayed muid course examOccurrence
E.&&. ( isCourseLecturer muid ata (course E.^. CourseId)
E.||. ( mayViewCourse muid ata now course Nothing -- do NOT remove, this is actually necessary here!
-- (There can be exam participants that are
-- not enrolled, me thinks)
E.&&. E.maybe E.false (\visibleFrom -> visibleFrom E.<=. E.val now) (exam E.^. ExamVisibleFrom) -- is the exam visible?
E.&&. E.maybe E.false (\publishOcc -> publishOcc E.<=. E.val now) (exam E.^. ExamPublishOccurrenceAssignments) -- are the exam occurrence assignments visible?
E.&&. (E.exists $ E.from $ \examRegistration -> E.where_ $
examRegistration E.^. ExamRegistrationExam E.==. exam E.^. ExamId
E.&&. E.just (examRegistration E.^. ExamRegistrationUser) E.==. E.val muid
E.&&. E.maybe E.true (\registrationOccurrence -> hasExamOccurrenceDisplayOptIn examOccurrence E.||. registrationOccurrence E.==. examOccurrence E.^. ExamOccurrenceId) (examRegistration E.^. ExamRegistrationOccurrence) -- if registered for a specific occurrence, get only this one and occurrences with an opt-in, otherwise get every occurrence available
)
)
)
E.where_ $ examOccurrenceShouldBeDisplayed muid ata now course exam examOccurrence
return (course, exam, examOccurrence)
where
hasExamOccurrenceDisplayOptIn examOccurrence = E.exists . E.from $ \examOccurrenceScheduleOpt -> E.where_ $
examOccurrenceScheduleOpt E.^. ExamOccurrenceScheduleOptExamOccurrence E.==. examOccurrence E.^. ExamOccurrenceId
E.&&. E.just (examOccurrenceScheduleOpt E.^. ExamOccurrenceScheduleOptUser) E.==. E.val muid
E.&&. examOccurrenceScheduleOpt E.^. ExamOccurrenceScheduleOptOpt
courseEventShouldBeDisplayed :: Maybe UserId -> E.SqlExpr (Entity Course) -> E.SqlExpr (Entity CourseEvent) -> E.SqlExpr (E.Value Bool)
courseEventShouldBeDisplayed (Just uid) course courseEvent = E.exists . E.from $ \user ->
courseEventShouldBeDisplayed :: Maybe UserId -> AuthTagActive -> E.SqlExpr (Entity Course) -> E.SqlExpr (Entity CourseEvent) -> E.SqlExpr (E.Value Bool)
courseEventShouldBeDisplayed muid@(Just uid) ata course courseEvent = E.exists . E.from $ \user ->
let
mCourseEventOpt = E.subSelect . E.from $ \courseEventScheduleOpt -> do
E.where_ $ courseEventScheduleOpt E.^. CourseEventScheduleOptCourseEvent E.==. courseEvent E.^. CourseEventId
@ -75,14 +51,18 @@ courseEventShouldBeDisplayed (Just uid) course courseEvent = E.exists . E.from $
in E.where_ $ user E.^. UserId E.==. E.val uid
E.&&. E.fromMaybe
( E.fromMaybe
(user E.^. UserScheduleOccurrenceDisplayDefault)
( user E.^. UserScheduleOccurrenceDisplayDefault
E.&&. ( isCourseParticipant muid ata (course E.^. CourseId)
E.||. isCourseLecturer muid ata (course E.^. CourseId)
)
)
mCourseOpt
)
mCourseEventOpt
courseEventShouldBeDisplayed _ _ _ = E.false
courseEventShouldBeDisplayed _ _ _ _ = E.false
tutorialShouldBeDisplayed :: Maybe UserId -> E.SqlExpr (Entity Course) -> E.SqlExpr (Entity Tutorial) -> E.SqlExpr (E.Value Bool)
tutorialShouldBeDisplayed (Just uid) course tutorial = E.exists . E.from $ \user ->
tutorialShouldBeDisplayed :: Maybe UserId -> AuthTagActive -> E.SqlExpr (Entity Course) -> E.SqlExpr (Entity Tutorial) -> E.SqlExpr (E.Value Bool)
tutorialShouldBeDisplayed muid@(Just uid) ata course tutorial = E.exists . E.from $ \user ->
let
mTutorialOpt = E.subSelect . E.from $ \tutorialScheduleOpt -> do
E.where_ $ tutorialScheduleOpt E.^. TutorialScheduleOptTutorial E.==. tutorial E.^. TutorialId
@ -92,28 +72,52 @@ tutorialShouldBeDisplayed (Just uid) course tutorial = E.exists . E.from $ \user
in E.where_ $ user E.^. UserId E.==. E.val uid
E.&&. E.fromMaybe
( E.fromMaybe
(user E.^. UserScheduleOccurrenceDisplayDefault)
( user E.^. UserScheduleOccurrenceDisplayDefault
E.&&. ( isTutorialTutor muid ata (tutorial E.^. TutorialId)
E.||. isTutorialParticipant muid ata (tutorial E.^. TutorialId)
)
)
mCourseOpt
)
mTutorialOpt
tutorialShouldBeDisplayed _ _ _ = E.false
tutorialShouldBeDisplayed _ _ _ _ = E.false
examOccurrenceShouldBeDisplayed :: Maybe UserId -> E.SqlExpr (Entity Course) -> E.SqlExpr (Entity ExamOccurrence) -> E.SqlExpr (E.Value Bool)
examOccurrenceShouldBeDisplayed (Just uid) course examOcc = E.exists . E.from $ \user ->
examOccurrenceShouldBeDisplayed :: Maybe UserId -> AuthTagActive -> UTCTime -> E.SqlExpr (Entity Course) -> E.SqlExpr (Entity Exam) -> E.SqlExpr (Entity ExamOccurrence) -> E.SqlExpr (E.Value Bool)
examOccurrenceShouldBeDisplayed muid@(Just uid) ata now course exam examOcc = E.exists . E.from $ \user ->
let
mExamOccOpt = E.subSelect . E.from $ \examOccScheduleOpt -> do
E.where_ $ examOccScheduleOpt E.^. ExamOccurrenceScheduleOptExamOccurrence E.==. examOcc E.^. ExamOccurrenceId
E.&&. examOccScheduleOpt E.^. ExamOccurrenceScheduleOptUser E.==. user E.^. UserId
return $ examOccScheduleOpt E.^. ExamOccurrenceScheduleOptOpt
mCourseOpt = E.subSelect $ getCourseScheduleOpt course user
--_hasExamOccurrenceDisplayOptIn examOccurrence = E.exists . E.from $ \examOccurrenceScheduleOpt -> E.where_ $
-- examOccurrenceScheduleOpt E.^. ExamOccurrenceScheduleOptExamOccurrence E.==. examOccurrence E.^. ExamOccurrenceId
-- E.&&. E.just (examOccurrenceScheduleOpt E.^. ExamOccurrenceScheduleOptUser) E.==. E.val muid
-- E.&&. examOccurrenceScheduleOpt E.^. ExamOccurrenceScheduleOptOpt
in E.where_ $ user E.^. UserId E.==. E.val uid
E.&&. E.fromMaybe
( E.fromMaybe
(user E.^. UserScheduleOccurrenceDisplayDefault)
( user E.^. UserScheduleOccurrenceDisplayDefault
E.&&. ( isCourseLecturer muid ata (course E.^. CourseId)
E.||. ( mayViewCourse muid ata now course Nothing -- do NOT remove, this is actually necessary here!
-- (There can be exam participants that are
-- not enrolled, me thinks)
E.&&. E.maybe E.false (\visibleFrom -> visibleFrom E.<=. E.val now) (exam E.^. ExamVisibleFrom) -- is the exam visible?
E.&&. E.maybe E.false (\publishOcc -> publishOcc E.<=. E.val now) (exam E.^. ExamPublishOccurrenceAssignments) -- are the exam occurrence assignments visible?
E.&&. (E.exists $ E.from $ \examRegistration -> E.where_ $
examRegistration E.^. ExamRegistrationExam E.==. exam E.^. ExamId
E.&&. E.just (examRegistration E.^. ExamRegistrationUser) E.==. E.val muid
E.&&. E.maybe E.true (\registrationOccurrence -> E.maybe E.false (const E.true) mExamOccOpt E.||. registrationOccurrence E.==. examOcc E.^. ExamOccurrenceId) (examRegistration E.^. ExamRegistrationOccurrence) -- if registered for a specific occurrence, get only this one and occurrences with an opt-in, otherwise get every occurrence available
)
)
)
)
mCourseOpt
)
mExamOccOpt
examOccurrenceShouldBeDisplayed _ _ _ = E.false
examOccurrenceShouldBeDisplayed _ _ _ _ _ _ = E.false
-- Local helper functions