From 0b3c88407b096ce25bebff0311f0898f92868530 Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Thu, 16 Apr 2020 09:26:37 +0200 Subject: [PATCH] refactor(course-user): modularize --- src/Foundation.hs | 25 +++ src/Handler/Course/User.hs | 192 ++++++++++-------- templates/course/user/note.hamlet | 3 + .../user/profile.hamlet} | 3 - 4 files changed, 132 insertions(+), 91 deletions(-) create mode 100644 templates/course/user/note.hamlet rename templates/{course-user.hamlet => course/user/profile.hamlet} (98%) diff --git a/src/Foundation.hs b/src/Foundation.hs index 8cbe2940a..878510f3d 100644 --- a/src/Foundation.hs +++ b/src/Foundation.hs @@ -1101,6 +1101,14 @@ tagAccessPredicate AuthParticipant = APDB $ \mAuthId route _ -> case route of E.&&. course E.^. CourseTerm E.==. E.val tid E.&&. course E.^. CourseSchool E.==. E.val ssh E.&&. course E.^. CourseShorthand E.==. E.val csh + -- participant is exam corrector for this course + mapExceptT ($cachedHereBinary (participant, tid, ssh, csh)) . authorizedIfExists $ \(course `E.InnerJoin` exam `E.InnerJoin` examCorrector) -> do + E.on $ exam E.^. ExamId E.==. examCorrector E.^. ExamCorrectorExam + E.on $ course E.^. CourseId E.==. exam E.^. ExamCourse + E.where_ $ examCorrector E.^. ExamCorrectorUser E.==. E.val participant + E.&&. course E.^. CourseTerm E.==. E.val tid + E.&&. course E.^. CourseSchool E.==. E.val ssh + E.&&. course E.^. CourseShorthand E.==. E.val csh -- participant is lecturer for this course mapExceptT ($cachedHereBinary (participant, tid, ssh, csh)) . authorizedIfExists $ \(course `E.InnerJoin` lecturer) -> do E.on $ course E.^. CourseId E.==. lecturer E.^. LecturerCourse @@ -1108,6 +1116,23 @@ tagAccessPredicate AuthParticipant = APDB $ \mAuthId route _ -> case route of E.&&. course E.^. CourseTerm E.==. E.val tid E.&&. course E.^. CourseSchool E.==. E.val ssh E.&&. course E.^. CourseShorthand E.==. E.val csh + -- participant has an exam result for this course + mapExceptT ($cachedHereBinary (participant, tid, ssh, csh)) . authorizedIfExists $ \(course `E.InnerJoin` exam `E.InnerJoin` examResult) -> do + E.on $ examResult E.^. ExamResultExam E.==. exam E.^. ExamId + E.on $ course E.^. CourseId E.==. exam E.^. ExamCourse + E.where_ $ examResult E.^. ExamResultUser E.==. E.val participant + E.&&. course E.^. CourseTerm E.==. E.val tid + E.&&. course E.^. CourseSchool E.==. E.val ssh + E.&&. course E.^. CourseShorthand E.==. E.val csh + -- participant is registered for an exam for this course + mapExceptT ($cachedHereBinary (participant, tid, ssh, csh)) . authorizedIfExists $ \(course `E.InnerJoin` exam `E.InnerJoin` examRegistration) -> do + E.on $ examRegistration E.^. ExamRegistrationExam E.==. exam E.^. ExamId + E.on $ course E.^. CourseId E.==. exam E.^. ExamCourse + E.where_ $ examRegistration E.^. ExamRegistrationUser E.==. E.val participant + E.&&. course E.^. CourseTerm E.==. E.val tid + E.&&. course E.^. CourseSchool E.==. E.val ssh + E.&&. course E.^. CourseShorthand E.==. E.val csh + return () tagAccessPredicate AuthApplicant = APDB $ \mAuthId route _ -> case route of diff --git a/src/Handler/Course/User.hs b/src/Handler/Course/User.hs index aef35f333..240c80cec 100644 --- a/src/Handler/Course/User.hs +++ b/src/Handler/Course/User.hs @@ -20,80 +20,53 @@ import Jobs.Queue getCUserR, postCUserR :: TermId -> SchoolId -> CourseShorthand -> CryptoUUIDUser -> Handler Html getCUserR = postCUserR postCUserR tid ssh csh uCId = do - -- Has authorization checks (OR): - -- - -- - User is current member of course - -- - User has submitted in course - -- - User is member of registered group for course - -- - User is member of a tutorial for course - -- - User is corrector for course - -- - User is a tutor for course - -- - User is a lecturer for course - let currentRoute = CourseR tid ssh csh (CUserR uCId) - Entity dozentId (userShowSex -> showSex) <- requireAuth - uid <- decrypt uCId - -- DB reads - (cid, User{..}, mRegistration, thisUniqueNote, noteText, noteEdits, studies) <- runDB $ do - cid <- getKeyBy404 $ TermSchoolCourseShort tid ssh csh - -- Abfrage Benutzerdaten + showSex <- maybe False (userShowSex . entityVal) <$> maybeAuth + + (course, user@(Entity _ User{..}), registered) <- runDB $ do + uid <- decrypt uCId + course@(Entity cid _) <- getBy404 $ TermSchoolCourseShort tid ssh csh user <- get404 uid - registration <- getBy (UniqueParticipant uid cid) - -- Abfrage Teilnehmernotiz - let thisUniqueNote = UniqueCourseUserNote uid cid - mbNoteEnt <- getBy thisUniqueNote - (noteText,noteEdits) <- case mbNoteEnt of - Nothing -> return (Nothing,[]) - (Just (Entity noteKey CourseUserNote{courseUserNoteNote})) -> do - noteEdits <- E.select $ E.from $ \(edit `E.InnerJoin` usr) -> do - E.on $ edit E.^. CourseUserNoteEditUser E.==. usr E.^. UserId - E.where_ $ edit E.^. CourseUserNoteEditNote E.==. E.val noteKey - E.orderBy [E.desc $ edit E.^. CourseUserNoteEditTime] - E.limit 1 -- more will be shown, if changed here - return (edit E.^. CourseUserNoteEditTime, usr E.^. UserEmail, usr E.^. UserDisplayName, usr E.^. UserSurname) - return (Just courseUserNoteNote, $(unValueN 4) <$> noteEdits) - -- Abfrage Studiengänge + registered <- existsBy $ UniqueParticipant uid cid + + return (course, Entity uid user, registered) + + sections <- mapM (runMaybeT . ($ user) . ($ course)) + [ courseUserProfileSection + , courseUserNoteSection + ] + + -- generate output + let headingLong + | registered + , Just sex <- guardOn showSex =<< userSex + = [whamlet|^{nameWidget userDisplayName userSurname} (_{ShortSex sex}), _{MsgCourseMemberOf} #{csh} #{tid}|] + | registered + = [whamlet|^{nameWidget userDisplayName userSurname}, _{MsgCourseMemberOf} #{csh} #{tid}|] + | Just sex <- guardOn showSex =<< userSex + = [whamlet|^{nameWidget userDisplayName userSurname} (_{ShortSex sex}), _{MsgCourseAssociatedWith} #{csh} #{tid}|] + | otherwise + = [whamlet|^{nameWidget userDisplayName userSurname}, _{MsgCourseAssociatedWith} #{csh} #{tid}|] + headingShort = prependCourseTitle tid ssh csh $ SomeMessage userDisplayName + siteLayout headingLong $ do + setTitleI headingShort + + forM_ sections . fromMaybe $ return () + +courseUserProfileSection :: Entity Course -> Entity User -> MaybeT Handler Widget +courseUserProfileSection (Entity cid Course{..}) (Entity uid User{ userShowSex = _, ..}) = do + showSex <- maybe False (userShowSex . entityVal) <$> maybeAuth + currentRoute <- MaybeT getCurrentRoute + + (mRegistration, studies) <- lift . runDB $ do + registration <- getBy $ UniqueParticipant uid cid studies <- E.select $ E.from $ \(studydegree `E.InnerJoin` studyfeat `E.InnerJoin` studyterms) -> do E.where_ $ studyfeat E.^. StudyFeaturesUser E.==. E.val uid E.on $ studyfeat E.^. StudyFeaturesField E.==. studyterms E.^. StudyTermsId E.on $ studyfeat E.^. StudyFeaturesDegree E.==. studydegree E.^. StudyDegreeId return (studyfeat, studydegree, studyterms) - return (cid, user, registration, thisUniqueNote, noteText, noteEdits, studies) - let editByWgt = [whamlet| - $newline never -