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