Authorisation CUserR for !participant
This commit is contained in:
SJost
parent
509e7f974c
commit
ec3b4ec4dd
@ -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
|
||||
|
||||
@ -38,3 +38,12 @@ CourseParticipant
|
||||
user UserId
|
||||
registration UTCTime
|
||||
UniqueParticipant user course
|
||||
CourseUserNote
|
||||
course CourseId
|
||||
user UserId
|
||||
note Text
|
||||
UniqueCourseUserNotes user course
|
||||
CourseUserNoteEdit
|
||||
user UserId
|
||||
time UTCTime
|
||||
note CourseUserNoteId
|
||||
|
||||
7
routes
7
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
|
||||
@ -34,9 +35,9 @@
|
||||
|
||||
/ 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/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
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -734,6 +734,7 @@ data AuthTag
|
||||
| AuthCorrector
|
||||
| AuthTime
|
||||
| AuthRegistered
|
||||
| AuthParticipant
|
||||
| AuthCapacity
|
||||
| AuthEmpty
|
||||
| AuthMaterials
|
||||
|
||||
Reference in New Issue
Block a user