fraport/fradrive
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
sectionIsHidden :: NotificationTriggerKind -> DB Bool
sectionIsHidden nt
| isAdmin
= return False
| Just uid <- mbUid
, NTKFunctionary f <- nt
= fmap not . E.selectExists . E.from $ \userFunction ->
E.where_ $ userFunction E.^. UserFunctionUser E.==. E.val uid
E.&&. userFunction E.^. UserFunctionFunction E.==. E.val f
| Just uid <- mbUid
, NTKCorrector <- nt
= fmap not . E.selectExists . E.from $ \sheetCorrector ->
E.where_ $ sheetCorrector E.^. SheetCorrectorUser E.==. E.val uid
| Just uid <- mbUid
, NTKCourseParticipant <- nt
= fmap not . E.selectExists . E.from $ \courseParticipant ->
E.where_ $ courseParticipant E.^. CourseParticipantUser E.==. E.val uid
E.&&. courseParticipant E.^. CourseParticipantState E.==. E.val CourseParticipantActive
| Just uid <- mbUid
, NTKSubmissionUser <- nt
= fmap not . E.selectExists . E.from $ \submissionUser ->
E.where_ $ submissionUser E.^. SubmissionUserUser E.==. E.val uid
| Just uid <- mbUid
, NTKExamParticipant <- nt
= fmap not . E.selectExists . E.from $ \examRegistration ->
E.where_ $ examRegistration E.^. ExamRegistrationUser E.==. E.val uid
| Just uid <- mbUid
, NTKCourseLecturer <- nt
= fmap not . E.selectExists . E.from $ \lecturer ->
E.where_ $ lecturer E.^. LecturerUser E.==. E.val uid
| otherwise
= return False
sectionIsHidden = \case
_
| isAdmin
-> return False
NTKAll
-> return False
NTKCourseParticipant
| Just uid <- mbUid
-> fmap not . E.selectExists . E.from $ \courseParticipant ->
E.where_ $ courseParticipant E.^. CourseParticipantUser E.==. E.val uid
E.&&. courseParticipant E.^. CourseParticipantState E.==. E.val CourseParticipantActive
NTKSubmissionUser
| Just uid <- mbUid
-> fmap not . E.selectExists . E.from $ \submissionUser ->
E.where_ $ submissionUser E.^. SubmissionUserUser E.==. E.val uid
NTKExamParticipant
| Just uid <- mbUid
-> fmap not . E.selectExists . E.from $ \examRegistration ->
E.where_ $ examRegistration E.^. ExamRegistrationUser E.==. E.val uid
NTKCorrector
| Just uid <- mbUid
-> fmap not . E.selectExists . E.from $ \sheetCorrector ->
E.where_ $ sheetCorrector E.^. SheetCorrectorUser E.==. E.val uid
NTKCourseLecturer
| Just uid <- mbUid
-> fmap not . E.selectExists . E.from $ \lecturer ->
E.where_ $ lecturer E.^. LecturerUser E.==. E.val uid
NTKAllocationStaff
| Just uid <- mbUid
-> fmap not . E.selectExists . E.from $ \(lecturer `E.InnerJoin` course `E.InnerJoin` allocationCourse) -> do
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
$ Set.fromList universeF