From ec3b4ec4ddab28ffeabf87553bb396cd52ed382d Mon Sep 17 00:00:00 2001 From: SJost Date: Wed, 9 Jan 2019 13:47:19 +0100 Subject: [PATCH] Authorisation CUserR for !participant --- messages/uniworx/de.msg | 5 +++- models/courses | 15 ++++++++-- routes | 25 ++++++++-------- src/Foundation.hs | 64 ++++++++++++++++++++++++++++++++++++++++- src/Handler/Course.hs | 8 ++++-- src/Handler/Profile.hs | 10 +++---- src/Handler/Sheet.hs | 2 +- src/Model/Types.hs | 1 + 8 files changed, 104 insertions(+), 26 deletions(-) diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg index 5521a602e..417600257 100644 --- a/messages/uniworx/de.msg +++ b/messages/uniworx/de.msg @@ -167,7 +167,8 @@ UnauthorizedLecturer: Sie sind nicht als Veranstalter für diese Veranstaltung e UnauthorizedCorrector: Sie sind nicht als Korrektor für diese Veranstaltung eingetragen. UnauthorizedSheetCorrector: Sie sind nicht als Korrektor für dieses Übungsblatt eingetragen. UnauthorizedCorrectorAny: Sie sind nicht als Korrektor für eine Veranstaltung eingetragen. -UnauthorizedParticipant: Sie sind nicht als Teilnehmer für diese Veranstaltung registriert. +UnauthorizedRegistered: Sie sind nicht als Teilnehmer für diese Veranstaltung registriert. +UnauthorizedParticipant: Angegebener Benutzer ist nicht als Teilnehmer dieser Veranstaltung registriert. UnauthorizedCourseTime: Dieses Kurs erlaubt momentan keine Anmeldungen. UnauthorizedSheetTime: Dieses Übungsblatt ist momentan nicht freigegeben. UnauthorizedSubmissionOwner: Sie sind an dieser Abgabe nicht beteiligt. @@ -354,6 +355,7 @@ DummyLoginTitle: Development-Login CorrectorNormal: Normal CorrectorMissing: Abwesend CorrectorExcused: Entschuldigt +CorrectorStateTip: Abwesende Korrektoren bekommen bei späteren Übungsblättern mehr Korrekturen zum Ausgleich zugewiesen. Entschuldigte Korrektoren müssen nicht nacharbeiten. DayIsAHoliday tid@TermId date@Text: #{date} ist ein Feiertag DayIsOutOfLecture tid@TermId date@Text: #{date} ist außerhalb der Vorlesungszeit des #{display tid} @@ -585,6 +587,7 @@ AuthTagLecturer: Nutzer ist Dozent AuthTagCorrector: Nutzer ist Korrektor AuthTagTime: Zeitliche Einschränkungen sind erfüllt AuthTagRegistered: Nutzer ist Kursteilnehmer +AuthTagParticipant: Nutzer ist mit Kurs assoziiert AuthTagCapacity: Kapazität ist ausreichend AuthTagEmpty: Kurs hat keine Teilnehmer AuthTagMaterials: Kursmaterialien sind freigegeben diff --git a/models/courses b/models/courses index 9ecc31abe..80b2ac5ac 100644 --- a/models/courses +++ b/models/courses @@ -34,7 +34,16 @@ Lecturer course CourseId UniqueLecturer user course CourseParticipant - course CourseId - user UserId - registration UTCTime + course CourseId + user UserId + registration UTCTime UniqueParticipant user course +CourseUserNote + course CourseId + user UserId + note Text + UniqueCourseUserNotes user course +CourseUserNoteEdit + user UserId + time UTCTime + note CourseUserNoteId diff --git a/routes b/routes index f29cc077b..f2b1d870c 100644 --- a/routes +++ b/routes @@ -14,6 +14,7 @@ -- !lecturer -- lecturer for this course (or the school, if route is not connected to a course) -- !corrector -- corrector for this sheet (or the submission, if route is connected to a submission, or the course, if route is not connected to a sheet, or any course, if route is not connected to a course) -- !registered -- participant for this course (no effect outside of courses) +-- !participant -- connected with a given course (not necessarily registered), i.e. has a submission, is a corrector, etc. (no effect outside of courses) -- !owner -- part of the group of owners of this submission -- !capacity -- course this route is associated with has at least one unit of participant capacity -- !empty -- course this route is associated with has no participants whatsoever @@ -32,19 +33,19 @@ /favicon.ico FaviconR GET !free /robots.txt RobotsR GET !free -/ HomeR GET !free -/users UsersR GET -- no tags, i.e. admins only -/admin/test AdminTestR GET POST -/admin/user/#CryptoUUIDUser AdminUserR GET !development -/admin/user/#CryptoUUIDUser/hijack AdminHijackUserR POST !adminANDno-escalation -/admin/errMsg AdminErrMsgR GET POST -/info VersionR GET !free -/help HelpR GET POST !free +/ HomeR GET !free +/users UsersR GET -- no tags, i.e. admins only +/users/#CryptoUUIDUser AdminUserR GET !development +/users/#CryptoUUIDUser/hijack AdminHijackUserR POST !adminANDno-escalation +/admin/test AdminTestR GET POST +/admin/errMsg AdminErrMsgR GET POST +/info VersionR GET !free +/help HelpR GET POST !free -/profile ProfileR GET POST !free -/profile/data ProfileDataR GET POST !free +/profile ProfileR GET POST !free +/profile/data ProfileDataR GET POST !free -/authpreds AuthPredsR GET POST !free +/authpreds AuthPredsR GET POST !free /term TermShowR GET !free /term/current TermCurrentR GET !free @@ -66,7 +67,7 @@ /edit CEditR GET POST /delete CDeleteR GET POST !lecturerANDempty /users CUsersR GET - /user/#CryptoUUIDUser CUserR GET !development + /users/#CryptoUUIDUser CUserR GET !lecturerANDparticipant /correctors CHiWisR GET /subs CCorrectionsR GET POST /ex SheetListR GET !registered !materials diff --git a/src/Foundation.hs b/src/Foundation.hs index 7d5aef0cd..d12d4371f 100644 --- a/src/Foundation.hs +++ b/src/Foundation.hs @@ -488,9 +488,71 @@ tagAccessPredicate AuthRegistered = APDB $ \route _ -> case route of E.&&. course E.^. CourseSchool E.==. E.val ssh E.&&. course E.^. CourseShorthand E.==. E.val csh return (E.countRows :: E.SqlExpr (E.Value Int64)) - guardMExceptT (c > 0) (unauthorizedI MsgUnauthorizedParticipant) + guardMExceptT (c > 0) (unauthorizedI MsgUnauthorizedRegistered) return Authorized r -> $unsupportedAuthPredicate AuthRegistered r +tagAccessPredicate AuthParticipant = APDB $ \route _ -> case route of + CourseR tid ssh csh (CUserR cID) -> exceptT return return $ do + let authorizedIfExists f = do + [E.Value ok] <- lift . E.select . return . E.exists $ E.from f + whenExceptT ok Authorized + participant <- decrypt cID + -- participant is currently registered + authorizedIfExists $ \(course `E.InnerJoin` courseParticipant) -> do + E.on $ course E.^. CourseId E.==. courseParticipant E.^. CourseParticipantCourse + E.where_ $ courseParticipant E.^. CourseParticipantUser 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 has at least one submission + authorizedIfExists $ \(course `E.InnerJoin` sheet `E.InnerJoin` submission `E.InnerJoin` submissionUser) -> do + E.on $ submission E.^. SubmissionId E.==. submissionUser E.^. SubmissionUserSubmission + E.on $ sheet E.^. SheetId E.==. submission E.^. SubmissionSheet + E.on $ course E.^. CourseId E.==. sheet E.^. SheetCourse + E.where_ $ submissionUser E.^. SubmissionUserUser 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 member of a submissionGroup + authorizedIfExists $ \(course `E.InnerJoin` submissionGroup `E.InnerJoin` submissionGroupUser) -> do + E.on $ submissionGroup E.^. SubmissionGroupId E.==. submissionGroupUser E.^. SubmissionGroupUserSubmissionGroup + E.on $ course E.^. CourseId E.==. submissionGroup E.^. SubmissionGroupCourse + E.where_ $ submissionGroupUser E.^. SubmissionGroupUserUser 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 a sheet corrector + authorizedIfExists $ \(course `E.InnerJoin` sheet `E.InnerJoin` sheetCorrector) -> do + E.on $ sheet E.^. SheetId E.==. sheetCorrector E.^. SheetCorrectorSheet + E.on $ course E.^. CourseId E.==. sheet E.^. SheetCourse + E.where_ $ sheetCorrector E.^. SheetCorrectorUser 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 a tutorial user + authorizedIfExists $ \(course `E.InnerJoin` tutorial `E.InnerJoin` tutorialUser) -> do + E.on $ tutorial E.^. TutorialId E.==. tutorialUser E.^. TutorialUserTutorial + E.on $ course E.^. CourseId E.==. tutorial E.^. TutorialCourse + E.where_ $ tutorialUser E.^. TutorialUserUser 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 tutor for this course + authorizedIfExists $ \(course `E.InnerJoin` tutorial) -> do + E.on $ course E.^. CourseId E.==. tutorial E.^. TutorialCourse + E.where_ $ tutorial E.^. TutorialTutor 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 + authorizedIfExists $ \(course `E.InnerJoin` lecturer) -> do + E.on $ course E.^. CourseId E.==. lecturer E.^. LecturerCourse + E.where_ $ lecturer E.^. LecturerUser 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 + unauthorizedI MsgUnauthorizedParticipant + r -> $unsupportedAuthPredicate AuthParticipant r tagAccessPredicate AuthCapacity = APDB $ \route _ -> case route of CourseR tid ssh csh _ -> maybeT (unauthorizedI MsgCourseNoCapacity) $ do Entity cid Course{..} <- MaybeT . getBy $ TermSchoolCourseShort tid ssh csh diff --git a/src/Handler/Course.hs b/src/Handler/Course.hs index e8cae3a63..cd9a82f96 100644 --- a/src/Handler/Course.hs +++ b/src/Handler/Course.hs @@ -600,13 +600,15 @@ getCUsersR = error "CUsersR: Not implemented" getCUserR :: TermId -> SchoolId -> CourseShorthand -> CryptoUUIDUser -> Handler Html getCUserR _tid _ssh _csh uCId = do - -- Needs authorization check: + -- 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 corrector for course (?) - -- - User is lecturer 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 uid <- decrypt uCId User{..} <- runDB $ get404 uid defaultLayout -- TODO diff --git a/src/Handler/Profile.hs b/src/Handler/Profile.hs index 0058fee8e..12a99c604 100644 --- a/src/Handler/Profile.hs +++ b/src/Handler/Profile.hs @@ -86,10 +86,10 @@ postProfileR = do _ -> return () let formText = Nothing :: Maybe UniWorXMessage - actionUrl = ProfileR + actionUrl = ProfileR defaultLayout $ do setTitle . toHtml $ userIdent <> "'s User page" - $(widgetFile "formPageI18n") + $(widgetFile "formPageI18n") postProfileDataR :: Handler Html postProfileDataR = do @@ -215,8 +215,8 @@ getProfileDataR = do <*> mkSubmissionTable uid -- Tabelle mit allen Abgaben und Abgabe-Gruppen <*> mkSubmissionGroupTable uid -- Tabelle mit allen Abgabegruppen <*> mkCorrectionsTable uid -- Tabelle mit allen Korrektor-Aufgaben - - + + let examTable = [whamlet| Klausuren werden momentan leider noch nicht unterstützt.|] let ownTutorialTable = [whamlet|Übungsgruppen werden momentan leider noch nicht unterstützt.|] let tutorialTable = [whamlet|Übungsgruppen werden momentan leider noch nicht unterstützt.|] @@ -304,7 +304,7 @@ mkEnrolledCoursesTable = termCell <$> view (_dbrOutput . _1 . _entityVal . _courseTerm) , sortable (Just "school") (i18nCell MsgCourseSchool) . magnify (_dbrOutput . _1 . _entityVal) $ schoolCell <$> view ( _courseTerm . re _Just) - <*> view _courseSchool + <*> view _courseSchool , sortable (Just "course") (i18nCell MsgCourse) $ courseCell <$> view (_dbrOutput . _1 . _entityVal) , sortable (Just "time") (i18nCell MsgRegistered) $ do diff --git a/src/Handler/Sheet.hs b/src/Handler/Sheet.hs index c938932d6..1b0af8650 100644 --- a/src/Handler/Sheet.hs +++ b/src/Handler/Sheet.hs @@ -722,7 +722,7 @@ correctorForm shid = do , countTutView , FieldView { fvLabel = text $ mr MsgCorrectors - , fvTooltip = Nothing + , fvTooltip = Just $ toHtml $ mr MsgCorrectorStateTip , fvId = "" , fvInput = Yesod.encodeCellTable tableDefault corrColonnade corrData >> mapM_ idField corrData >> mapM_ delField deletions' , fvErrors = Nothing diff --git a/src/Model/Types.hs b/src/Model/Types.hs index accb05fe0..28dc6890c 100644 --- a/src/Model/Types.hs +++ b/src/Model/Types.hs @@ -734,6 +734,7 @@ data AuthTag | AuthCorrector | AuthTime | AuthRegistered + | AuthParticipant | AuthCapacity | AuthEmpty | AuthMaterials