From 1d34cae4e2009f450bea221ee1614d360b722289 Mon Sep 17 00:00:00 2001 From: Sarah Vaupel <> Date: Mon, 9 Nov 2020 19:27:20 +0100 Subject: [PATCH] fix(schedule): make course schedule opt-ins work for unregistered users --- src/Utils/Schedule.hs | 82 +++++++++++++++++++++++-------------------- 1 file changed, 43 insertions(+), 39 deletions(-) diff --git a/src/Utils/Schedule.hs b/src/Utils/Schedule.hs index 13b6ece51..c7416fbe4 100644 --- a/src/Utils/Schedule.hs +++ b/src/Utils/Schedule.hs @@ -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