From 5841a7b5d2c9ee1b291a003f3d03b41d5e0b5d95 Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Mon, 16 Sep 2019 10:12:17 +0200 Subject: [PATCH] feat(exam-office): exam-office permissions by courseSchool --- src/Foundation.hs | 2 +- src/Handler/ExamOffice/Exam.hs | 3 +- src/Handler/ExamOffice/Exams.hs | 7 ++--- src/Handler/Utils/ExamOffice/Course.hs | 16 ++++++++-- src/Handler/Utils/ExamOffice/Exam.hs | 38 ++++++++++++++++++++++- src/Handler/Utils/ExamOffice/Exam/Auth.hs | 34 -------------------- src/Jobs/Handler/QueueNotification.hs | 2 +- 7 files changed, 56 insertions(+), 46 deletions(-) delete mode 100644 src/Handler/Utils/ExamOffice/Exam/Auth.hs diff --git a/src/Foundation.hs b/src/Foundation.hs index 8c0da6278..cf8f8d601 100644 --- a/src/Foundation.hs +++ b/src/Foundation.hs @@ -66,7 +66,7 @@ import qualified Control.Monad.Catch as C import Handler.Utils.StudyFeatures import Handler.Utils.SchoolLdap -import Handler.Utils.ExamOffice.Exam.Auth +import Handler.Utils.ExamOffice.Exam import Handler.Utils.ExamOffice.Course import Handler.Utils.Profile import Utils.Form diff --git a/src/Handler/ExamOffice/Exam.hs b/src/Handler/ExamOffice/Exam.hs index 318313817..4aeb046cd 100644 --- a/src/Handler/ExamOffice/Exam.hs +++ b/src/Handler/ExamOffice/Exam.hs @@ -7,7 +7,6 @@ import Handler.Utils import Handler.Utils.Exam import Handler.Utils.Csv import qualified Handler.Utils.ExamOffice.Exam as Exam -import Handler.Utils.ExamOffice.Exam.Auth import qualified Database.Esqueleto as E import qualified Database.Esqueleto.Utils as E @@ -228,7 +227,7 @@ postEGradesR tid ssh csh examn = do E.where_ $ examResult E.^. ExamResultExam E.==. E.val eid unless isLecturer $ - E.where_ $ examOfficeExamResultAuth (E.val uid) examResult + E.where_ $ Exam.examOfficeExamResultAuth (E.val uid) examResult return (examResult, user, occurrence, studyFeatures, studyDegree, studyField, examRegistration, isSynced) dbtRowKey = views queryExamResult (E.^. ExamResultId) diff --git a/src/Handler/ExamOffice/Exams.hs b/src/Handler/ExamOffice/Exams.hs index 69ce6d6f3..96637f5a3 100644 --- a/src/Handler/ExamOffice/Exams.hs +++ b/src/Handler/ExamOffice/Exams.hs @@ -5,7 +5,6 @@ module Handler.ExamOffice.Exams import Import import Handler.Utils -import Handler.Utils.ExamOffice.Exam.Auth import qualified Handler.Utils.ExamOffice.Exam as Exam import qualified Database.Esqueleto as E @@ -34,7 +33,7 @@ querySynchronised office = to . runReader $ do let synchronised = E.sub_select . E.from $ \examResult -> do E.where_ $ examResult E.^. ExamResultExam E.==. exam E.^. ExamId - E.where_ $ examOfficeExamResultAuth office examResult + E.where_ $ Exam.examOfficeExamResultAuth office examResult E.where_ $ Exam.resultIsSynced office examResult return E.countRows return synchronised @@ -45,7 +44,7 @@ queryResults office = to . runReader $ do let results = E.sub_select . E.from $ \examResult -> do E.where_ $ examResult E.^. ExamResultExam E.==. exam E.^. ExamId - E.where_ $ examOfficeExamResultAuth office examResult + E.where_ $ Exam.examOfficeExamResultAuth office examResult return E.countRows return results @@ -55,7 +54,7 @@ queryIsSynced office = to . runReader $ do let synchronised = E.not_ . E.exists . E.from $ \examResult -> do E.where_ $ examResult E.^. ExamResultExam E.==. exam E.^. ExamId - E.where_ $ examOfficeExamResultAuth office examResult + E.where_ $ Exam.examOfficeExamResultAuth office examResult E.where_ . E.not_ $ Exam.resultIsSynced office examResult return synchronised diff --git a/src/Handler/Utils/ExamOffice/Course.hs b/src/Handler/Utils/ExamOffice/Course.hs index ec2ecd81d..bd3a3a5c2 100644 --- a/src/Handler/Utils/ExamOffice/Course.hs +++ b/src/Handler/Utils/ExamOffice/Course.hs @@ -11,8 +11,8 @@ import qualified Database.Esqueleto.Utils as E courseExamOfficeSchools :: E.SqlExpr (E.Value UserId) -> E.SqlExpr (E.Value CourseId) -> E.SqlQuery (E.SqlExpr (Entity School), E.SqlExpr (E.Value Bool)) -- ^ @Entity School@ and @forced@ -courseExamOfficeSchools user _course = E.from $ \(school `E.InnerJoin` userFunction `E.InnerJoin` (examOfficeField `E.FullOuterJoin` examOfficeUser)) - -> E.distinctOnOrderBy [E.asc $ userFunction E.^. UserFunctionSchool] $ do +courseExamOfficeSchools user course = E.from $ \((school `E.InnerJoin` userFunction) `E.LeftOuterJoin` (examOfficeField `E.FullOuterJoin` examOfficeUser)) + -> E.distinctOnOrderBy [E.asc $ school E.^. SchoolId] $ do E.on E.false E.on $ ( examOfficeUser E.?. ExamOfficeUserUser E.==. E.just user E.&&. examOfficeUser E.?. ExamOfficeUserOffice E.==. E.just (userFunction E.^. UserFunctionUser) @@ -26,7 +26,17 @@ courseExamOfficeSchools user _course = E.from $ \(school `E.InnerJoin` userFunct E.on $ school E.^. SchoolId E.==. userFunction E.^. UserFunctionSchool E.&&. userFunction E.^. UserFunctionFunction E.==. E.val SchoolExamOffice - let forced = E.maybe E.true id $ examOfficeField E.?. ExamOfficeFieldForced + let byUser = E.not_ . E.isNothing $ examOfficeUser E.?. ExamOfficeUserId + byField = E.not_ . E.isNothing $ examOfficeField E.?. ExamOfficeFieldId + byCourse = E.exists . E.from $ \course' -> + E.where_ $ course' E.^. CourseId E.==. course + E.&&. course' E.^. CourseSchool E.==. school E.^. SchoolId + + forced = byUser + E.||. byCourse + E.||. E.maybe E.true id (examOfficeField E.?. ExamOfficeFieldForced) + + E.where_ $ byUser E.||. byField E.||. byCourse E.orderBy [E.desc forced] return (school, forced) diff --git a/src/Handler/Utils/ExamOffice/Exam.hs b/src/Handler/Utils/ExamOffice/Exam.hs index 806ba943b..30f1d30c9 100644 --- a/src/Handler/Utils/ExamOffice/Exam.hs +++ b/src/Handler/Utils/ExamOffice/Exam.hs @@ -1,5 +1,6 @@ module Handler.Utils.ExamOffice.Exam ( resultIsSynced + , examOfficeExamResultAuth ) where import Import.NoFoundation @@ -9,7 +10,7 @@ import qualified Database.Esqueleto as E resultIsSynced :: E.SqlExpr (E.Value UserId) -- ^ office -> E.SqlExpr (Entity ExamResult) -> E.SqlExpr (E.Value Bool) -resultIsSynced authId examResult = (hasSchool E.&&. allSchools) E.||. anySync +resultIsSynced authId examResult = (hasSchool E.&&. allSchools) E.||. (E.not_ hasSchool E.&&. anySync) where anySync = E.exists . E.from $ \synced -> E.where_ $ synced E.^. ExamOfficeResultSyncedResult E.==. examResult E.^. ExamResultId @@ -25,3 +26,38 @@ resultIsSynced authId examResult = (hasSchool E.&&. allSchools) E.||. anySync E.where_ $ synced E.^. ExamOfficeResultSyncedSchool E.==. E.just (userFunction E.^. UserFunctionSchool) E.&&. synced E.^. ExamOfficeResultSyncedResult E.==. examResult E.^. ExamResultId E.&&. synced E.^. ExamOfficeResultSyncedTime E.>=. examResult E.^. ExamResultLastChanged + + +examOfficeExamResultAuth :: E.SqlExpr (E.Value UserId) -- ^ office + -> E.SqlExpr (Entity ExamResult) + -> E.SqlExpr (E.Value Bool) +examOfficeExamResultAuth authId examResult = authByUser E.||. authByField E.||. authBySchool + where + authByField = E.exists . E.from $ \(examOfficeField `E.InnerJoin` studyFeatures) -> do + E.on $ studyFeatures E.^. StudyFeaturesField E.==. examOfficeField E.^. ExamOfficeFieldField + E.where_ $ studyFeatures E.^. StudyFeaturesUser E.==. examResult E.^. ExamResultUser + E.&&. examOfficeField E.^. ExamOfficeFieldOffice E.==. authId + E.&&. examOfficeField E.^. ExamOfficeFieldField E.==. studyFeatures E.^. StudyFeaturesField + E.where_ $ examOfficeField E.^. ExamOfficeFieldForced + E.||. E.exists (E.from $ \userFunction -> + E.where_ $ userFunction E.^. UserFunctionUser E.==. authId + E.&&. userFunction E.^. UserFunctionFunction E.==. E.val SchoolExamOffice + E.&&. E.not_ (E.exists . E.from $ \(course `E.InnerJoin` exam `E.InnerJoin` courseUserExamOfficeOptOut) -> do + E.on $ courseUserExamOfficeOptOut E.^. CourseUserExamOfficeOptOutCourse E.==. course E.^. CourseId + E.on $ exam E.^. ExamCourse E.==. course E.^. CourseId + E.where_ $ exam E.^. ExamId E.==. examResult E.^. ExamResultExam + E.where_ $ courseUserExamOfficeOptOut E.^. CourseUserExamOfficeOptOutUser E.==. examResult E.^. ExamResultUser + E.&&. courseUserExamOfficeOptOut E.^. CourseUserExamOfficeOptOutSchool E.==. userFunction E.^. UserFunctionSchool + ) + ) + + authByUser = E.exists . E.from $ \examOfficeUser -> + E.where_ $ examOfficeUser E.^. ExamOfficeUserOffice E.==. authId + E.&&. examOfficeUser E.^. ExamOfficeUserUser E.==. examResult E.^. ExamResultUser + + authBySchool = E.exists . E.from $ \(userFunction `E.InnerJoin` course `E.InnerJoin` exam) -> do + E.on $ course E.^. CourseId E.==. exam E.^. ExamCourse + E.&&. exam E.^. ExamId E.==. examResult E.^. ExamResultExam + E.on $ course E.^. CourseSchool E.==. userFunction E.^. UserFunctionSchool + E.&&. userFunction E.^. UserFunctionFunction E.==. E.val SchoolExamOffice + E.where_ $ userFunction E.^. UserFunctionUser E.==. authId diff --git a/src/Handler/Utils/ExamOffice/Exam/Auth.hs b/src/Handler/Utils/ExamOffice/Exam/Auth.hs deleted file mode 100644 index 3d8bff67a..000000000 --- a/src/Handler/Utils/ExamOffice/Exam/Auth.hs +++ /dev/null @@ -1,34 +0,0 @@ -module Handler.Utils.ExamOffice.Exam.Auth - ( examOfficeExamResultAuth - ) where - -import Import.NoFoundation - -import qualified Database.Esqueleto as E - - -examOfficeExamResultAuth :: E.SqlExpr (E.Value UserId) -- ^ office - -> E.SqlExpr (Entity ExamResult) - -> E.SqlExpr (E.Value Bool) -examOfficeExamResultAuth authId examResult = authByUser E.||. authByField - where - authByField = E.exists . E.from $ \(examOfficeField `E.InnerJoin` studyFeatures) -> do - E.on $ studyFeatures E.^. StudyFeaturesField E.==. examOfficeField E.^. ExamOfficeFieldField - E.where_ $ studyFeatures E.^. StudyFeaturesUser E.==. examResult E.^. ExamResultUser - E.&&. examOfficeField E.^. ExamOfficeFieldOffice E.==. authId - E.&&. examOfficeField E.^. ExamOfficeFieldField E.==. studyFeatures E.^. StudyFeaturesField - E.where_ $ examOfficeField E.^. ExamOfficeFieldForced - E.||. E.exists (E.from $ \userFunction -> - E.where_ $ userFunction E.^. UserFunctionUser E.==. authId - E.&&. userFunction E.^. UserFunctionFunction E.==. E.val SchoolExamOffice - E.&&. E.not_ (E.exists . E.from $ \(course `E.InnerJoin` exam `E.InnerJoin` courseUserExamOfficeOptOut) -> do - E.on $ courseUserExamOfficeOptOut E.^. CourseUserExamOfficeOptOutCourse E.==. course E.^. CourseId - E.on $ exam E.^. ExamCourse E.==. course E.^. CourseId - E.where_ $ exam E.^. ExamId E.==. examResult E.^. ExamResultExam - E.where_ $ courseUserExamOfficeOptOut E.^. CourseUserExamOfficeOptOutUser E.==. examResult E.^. ExamResultUser - E.&&. courseUserExamOfficeOptOut E.^. CourseUserExamOfficeOptOutSchool E.==. userFunction E.^. UserFunctionSchool - ) - ) - authByUser = E.exists . E.from $ \examOfficeUser -> - E.where_ $ examOfficeUser E.^. ExamOfficeUserOffice E.==. authId - E.&&. examOfficeUser E.^. ExamOfficeUserUser E.==. examResult E.^. ExamResultUser diff --git a/src/Jobs/Handler/QueueNotification.hs b/src/Jobs/Handler/QueueNotification.hs index 2fb31851f..93f5d0c33 100644 --- a/src/Jobs/Handler/QueueNotification.hs +++ b/src/Jobs/Handler/QueueNotification.hs @@ -15,7 +15,7 @@ import Jobs.Queue import qualified Data.Set as Set -import Handler.Utils.ExamOffice.Exam.Auth +import Handler.Utils.ExamOffice.Exam dispatchJobQueueNotification :: Notification -> Handler ()