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

fix(notification-form): define rules for all notification-triggers

Browse Source 
Fixes #561
This commit is contained in:
Gregor Kleen 2020-08-21 12:09:17 +02:00
parent ea97fe4763
commit 0261b3979d
1 changed files with 44 additions and 31 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

75
src/Handler/Profile.hs
View File

@ -144,37 +144,50 @@ notificationForm template = wFormToAForm $ do
let let
sectionIsHidden :: NotificationTriggerKind -> DB Bool sectionIsHidden :: NotificationTriggerKind -> DB Bool
sectionIsHidden nt sectionIsHidden = \case
| isAdmin _
= return False | isAdmin
| Just uid <- mbUid -> return False
, NTKFunctionary f <- nt NTKAll
= fmap not . E.selectExists . E.from $ \userFunction -> -> return False
E.where_ $ userFunction E.^. UserFunctionUser E.==. E.val uid NTKCourseParticipant
E.&&. userFunction E.^. UserFunctionFunction E.==. E.val f | Just uid <- mbUid
| Just uid <- mbUid -> fmap not . E.selectExists . E.from $ \courseParticipant ->
, NTKCorrector <- nt E.where_ $ courseParticipant E.^. CourseParticipantUser E.==. E.val uid
= fmap not . E.selectExists . E.from $ \sheetCorrector -> E.&&. courseParticipant E.^. CourseParticipantState E.==. E.val CourseParticipantActive
E.where_ $ sheetCorrector E.^. SheetCorrectorUser E.==. E.val uid NTKSubmissionUser
| Just uid <- mbUid | Just uid <- mbUid
, NTKCourseParticipant <- nt -> fmap not . E.selectExists . E.from $ \submissionUser ->
= fmap not . E.selectExists . E.from $ \courseParticipant -> E.where_ $ submissionUser E.^. SubmissionUserUser E.==. E.val uid
E.where_ $ courseParticipant E.^. CourseParticipantUser E.==. E.val uid NTKExamParticipant
E.&&. courseParticipant E.^. CourseParticipantState E.==. E.val CourseParticipantActive | Just uid <- mbUid
| Just uid <- mbUid -> fmap not . E.selectExists . E.from $ \examRegistration ->
, NTKSubmissionUser <- nt E.where_ $ examRegistration E.^. ExamRegistrationUser E.==. E.val uid
= fmap not . E.selectExists . E.from $ \submissionUser -> NTKCorrector
E.where_ $ submissionUser E.^. SubmissionUserUser E.==. E.val uid | Just uid <- mbUid
| Just uid <- mbUid -> fmap not . E.selectExists . E.from $ \sheetCorrector ->
, NTKExamParticipant <- nt E.where_ $ sheetCorrector E.^. SheetCorrectorUser E.==. E.val uid
= fmap not . E.selectExists . E.from $ \examRegistration -> NTKCourseLecturer
E.where_ $ examRegistration E.^. ExamRegistrationUser E.==. E.val uid | Just uid <- mbUid
| Just uid <- mbUid -> fmap not . E.selectExists . E.from $ \lecturer ->
, NTKCourseLecturer <- nt E.where_ $ lecturer E.^. LecturerUser E.==. E.val uid
= fmap not . E.selectExists . E.from $ \lecturer -> NTKAllocationStaff
E.where_ $ lecturer E.^. LecturerUser E.==. E.val uid | Just uid <- mbUid
| otherwise -> fmap not . E.selectExists . E.from $ \(lecturer `E.InnerJoin` course `E.InnerJoin` allocationCourse) -> do
= return False E.on $ allocationCourse E.^. AllocationCourseCourse E.==. course E.^. CourseId
E.on $ lecturer E.^. LecturerCourse E.==. course E.^. CourseId
E.where_ $ lecturer E.^. LecturerUser E.==. E.val uid
NTKAllocationParticipant
| Just uid <- mbUid
-> fmap not . E.selectExists . E.from $ \courseApplication ->
E.where_ $ courseApplication E.^. CourseApplicationUser E.==. E.val uid
E.&&. E.not_ (E.isNothing $ courseApplication E.^. CourseApplicationAllocation)
NTKFunctionary f
| Just uid <- mbUid
-> fmap not . E.selectExists . E.from $ \userFunction ->
E.where_ $ userFunction E.^. UserFunctionUser E.==. E.val uid
E.&&. userFunction E.^. UserFunctionFunction E.==. E.val f
_ | Nothing <- mbUid -> return False -- Show everything for not-logged-in users (e.g. if they presented a token)
ntHidden <- liftHandler . runDB ntHidden <- liftHandler . runDB
$ Set.fromList universeF $ Set.fromList universeF