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

refactor(course-visibility): guard on user id and auth tag before exists

Browse Source
This commit is contained in:
Sarah Vaupel 2020-08-10 13:47:53 +02:00
parent 036d761ec8
commit 6a0774bff3
1 changed files with 51 additions and 43 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

94
src/Utils/Course.hs
View File

@ -42,20 +42,20 @@ mayEditCourse' muid ata (Entity cid Course{..}) =
isSchoolAdmin :: Maybe UserId -> AuthTagActive -> E.SqlExpr (E.Value SchoolId) -> E.SqlExpr (E.Value Bool)
isSchoolAdmin muid AuthTagActive{..} ssh = E.exists . E.from $ \(user `E.InnerJoin` userFunction) -> do
E.on $ user E.^. UserId E.==. userFunction E.^. UserFunctionUser
E.where_ $ E.just (user E.^. UserId) E.==. E.val muid
E.&&. userFunction E.^. UserFunctionSchool E.==. ssh
E.&&. userFunction E.^. UserFunctionFunction E.==. E.val SchoolAdmin
E.&&. E.val (authTagIsActive AuthAdmin)
isSchoolAdmin muid AuthTagActive{..} ssh
| Just uid <- muid, authTagIsActive AuthAdmin = E.exists . E.from $ \(user `E.InnerJoin` userFunction) -> do
E.on $ user E.^. UserId E.==. userFunction E.^. UserFunctionUser
E.where_ $ user E.^. UserId E.==. E.val uid
E.&&. userFunction E.^. UserFunctionSchool E.==. ssh
E.&&. userFunction E.^. UserFunctionFunction E.==. E.val SchoolAdmin
| otherwise = E.false
isSchoolAdminLike :: Maybe UserId -> AuthTagActive -> E.SqlExpr (E.Value SchoolId) -> E.SqlExpr (E.Value Bool)
isSchoolAdminLike muid ata@AuthTagActive{..} ssh =
isSchoolAdmin muid ata ssh
E.||. (E.exists . E.from $ \(user `E.InnerJoin` userFunction) -> do
isSchoolAdminLike muid ata@AuthTagActive{..} ssh
| Just uid <- muid = isSchoolAdmin muid ata ssh E.||. (E.exists . E.from $ \(user `E.InnerJoin` userFunction) -> do
E.on $ user E.^. UserId E.==. userFunction E.^. UserFunctionUser
E.where_ $ E.just (user E.^. UserId) E.==. E.val muid
E.&&. userFunction E.^. UserFunctionSchool E.==. ssh
E.where_ $ user E.^. UserId E.==. E.val uid
E.&&. userFunction E.^. UserFunctionSchool E.==. ssh
E.&&. ( (userFunction E.^. UserFunctionFunction E.==. E.val SchoolEvaluation
E.&&. E.val (authTagIsActive AuthEvaluation))
E.||. (userFunction E.^. UserFunctionFunction E.==. E.val SchoolExamOffice
@ -64,50 +64,58 @@ isSchoolAdminLike muid ata@AuthTagActive{..} ssh =
E.&&. E.val (authTagIsActive AuthAllocationAdmin))
)
)
| otherwise = E.false
isCourseLecturer :: Maybe UserId -> AuthTagActive -> E.SqlExpr (E.Value CourseId) -> E.SqlExpr (E.Value Bool)
isCourseLecturer muid AuthTagActive{..} cid = E.exists . E.from $ \(user `E.InnerJoin` lecturer) -> do
E.on $ user E.^. UserId E.==. lecturer E.^. LecturerUser
E.where_ $ E.just (user E.^. UserId) E.==. E.val muid
E.&&. lecturer E.^. LecturerCourse E.==. cid
E.&&. E.val (authTagIsActive AuthLecturer)
isCourseLecturer muid AuthTagActive{..} cid
| Just uid <- muid, authTagIsActive AuthLecturer = E.exists . E.from $ \(user `E.InnerJoin` lecturer) -> do
E.on $ user E.^. UserId E.==. lecturer E.^. LecturerUser
E.where_ $ user E.^. UserId E.==. E.val uid
E.&&. lecturer E.^. LecturerCourse E.==. cid
| otherwise = E.false
isCourseTutor :: Maybe UserId -> AuthTagActive -> E.SqlExpr (E.Value CourseId) -> E.SqlExpr (E.Value Bool)
isCourseTutor muid AuthTagActive{..} cid = E.exists . E.from $ \(tutor `E.InnerJoin` tutorial) -> do
E.on $ tutor E.^. TutorTutorial E.==. tutorial E.^. TutorialId
E.where_ $ E.just (tutor E.^. TutorUser) E.==. E.val muid
E.&&. tutorial E.^. TutorialCourse E.==. cid
E.&&. E.val (authTagIsActive AuthTutor)
isCourseTutor muid AuthTagActive{..} cid
| Just uid <- muid, authTagIsActive AuthTutor = E.exists . E.from $ \(tutor `E.InnerJoin` tutorial) -> do
E.on $ tutor E.^. TutorTutorial E.==. tutorial E.^. TutorialId
E.where_ $ tutor E.^. TutorUser E.==. E.val uid
E.&&. tutorial E.^. TutorialCourse E.==. cid
| otherwise = E.false
isCourseSheetCorrector :: Maybe UserId -> AuthTagActive -> E.SqlExpr (E.Value CourseId) -> E.SqlExpr (E.Value Bool)
isCourseSheetCorrector muid AuthTagActive{..} cid = E.exists . E.from $ \(sheetCorrector `E.InnerJoin` sheet) -> do
E.on $ sheetCorrector E.^. SheetCorrectorSheet E.==. sheet E.^. SheetId
E.where_ $ E.just (sheetCorrector E.^. SheetCorrectorUser) E.==. E.val muid
E.&&. sheet E.^. SheetCourse E.==. cid
E.&&. E.val (authTagIsActive AuthCorrector)
isCourseSheetCorrector muid AuthTagActive{..} cid
| Just uid <- muid, authTagIsActive AuthCorrector = E.exists . E.from $ \(sheetCorrector `E.InnerJoin` sheet) -> do
E.on $ sheetCorrector E.^. SheetCorrectorSheet E.==. sheet E.^. SheetId
E.where_ $ sheetCorrector E.^. SheetCorrectorUser E.==. E.val uid
E.&&. sheet E.^. SheetCourse E.==. cid
| otherwise = E.false
isCourseExamCorrector :: Maybe UserId -> AuthTagActive -> E.SqlExpr (E.Value CourseId) -> E.SqlExpr (E.Value Bool)
isCourseExamCorrector muid AuthTagActive{..} cid = E.exists . E.from $ \(examCorrector `E.InnerJoin` exam) -> do
E.on $ examCorrector E.^. ExamCorrectorExam E.==. exam E.^. ExamId
E.where_ $ E.just (examCorrector E.^. ExamCorrectorUser) E.==. E.val muid
E.&&. exam E.^. ExamCourse E.==. cid
E.&&. E.val (authTagIsActive AuthExamCorrector)
isCourseExamCorrector muid AuthTagActive{..} cid
| Just uid <- muid, authTagIsActive AuthExamCorrector = E.exists . E.from $ \(examCorrector `E.InnerJoin` exam) -> do
E.on $ examCorrector E.^. ExamCorrectorExam E.==. exam E.^. ExamId
E.where_ $ examCorrector E.^. ExamCorrectorUser E.==. E.val uid
E.&&. exam E.^. ExamCourse E.==. cid
| otherwise = E.false
isCourseParticipant :: Maybe UserId -> AuthTagActive -> E.SqlExpr (E.Value CourseId) -> E.SqlExpr (E.Value Bool)
isCourseParticipant muid AuthTagActive{..} cid = E.exists . E.from $ \courseParticipant -> E.where_ $
E.just (courseParticipant E.^. CourseParticipantUser) E.==. E.val muid
E.&&. courseParticipant E.^. CourseParticipantCourse E.==. cid
E.&&. courseParticipant E.^. CourseParticipantState E.==. E.val CourseParticipantActive
E.&&. E.val (authTagIsActive AuthCourseRegistered)
isCourseParticipant muid AuthTagActive{..} cid
| Just uid <- muid, authTagIsActive AuthCourseRegistered = E.exists . E.from $ \courseParticipant -> E.where_ $
courseParticipant E.^. CourseParticipantUser E.==. E.val uid
E.&&. courseParticipant E.^. CourseParticipantCourse E.==. cid
E.&&. courseParticipant E.^. CourseParticipantState E.==. E.val CourseParticipantActive
E.&&. E.val (authTagIsActive AuthCourseRegistered)
| otherwise = E.false
isCourseApplicant :: Maybe UserId -> AuthTagActive -> E.SqlExpr (E.Value CourseId) -> Maybe (E.SqlExpr (E.Value AllocationId)) -> E.SqlExpr (E.Value Bool)
isCourseApplicant muid AuthTagActive{..} cid maid = E.exists . E.from $ \courseApplication -> E.where_ $
E.just (courseApplication E.^. CourseApplicationUser) E.==. E.val muid
E.&&. courseApplication E.^. CourseApplicationCourse E.==. cid
E.&&. E.val (authTagIsActive AuthApplicant)
E.&&. maybe E.true
(\aid -> E.just aid E.==. courseApplication E.^. CourseApplicationAllocation)
maid
isCourseApplicant muid AuthTagActive{..} cid maid
| Just uid <- muid, authTagIsActive AuthApplicant = E.exists . E.from $ \courseApplication -> E.where_ $
courseApplication E.^. CourseApplicationUser E.==. E.val uid
E.&&. courseApplication E.^. CourseApplicationCourse E.==. cid
E.&&. maybe E.true
(\aid -> E.just aid E.==. courseApplication E.^. CourseApplicationAllocation)
maid
| otherwise = E.false
isCourseAssociated :: Maybe UserId -> AuthTagActive -> E.SqlExpr (E.Value CourseId) -> Maybe (E.SqlExpr (E.Value AllocationId)) -> E.SqlExpr (E.Value Bool)
isCourseAssociated muid ata cid maid =