fraport/fradrive
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Authorisation CUserR for !participant

Browse Source
This commit is contained in:
SJost 2019-01-09 13:47:19 +01:00
parent 509e7f974c
commit ec3b4ec4dd
8 changed files with 104 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
messages/uniworx/de.msg
View File

@ -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

15
models/courses
View File

@ -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

25
routes
View File

@ -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

64
src/Foundation.hs
View File

@ -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

8
src/Handler/Course.hs
View File

@ -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

10
src/Handler/Profile.hs
View File

@ -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

2
src/Handler/Sheet.hs
View File

@ -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

1
src/Model/Types.hs
View File

@ -734,6 +734,7 @@ data AuthTag
| AuthCorrector
| AuthTime
| AuthRegistered
| AuthParticipant
| AuthCapacity
| AuthEmpty
| AuthMaterials