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. UnauthorizedCorrector: Sie sind nicht als Korrektor für diese Veranstaltung eingetragen.
UnauthorizedSheetCorrector: Sie sind nicht als Korrektor für dieses Übungsblatt eingetragen. UnauthorizedSheetCorrector: Sie sind nicht als Korrektor für dieses Übungsblatt eingetragen.
UnauthorizedCorrectorAny: Sie sind nicht als Korrektor für eine Veranstaltung 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. UnauthorizedCourseTime: Dieses Kurs erlaubt momentan keine Anmeldungen.
UnauthorizedSheetTime: Dieses Übungsblatt ist momentan nicht freigegeben. UnauthorizedSheetTime: Dieses Übungsblatt ist momentan nicht freigegeben.
UnauthorizedSubmissionOwner: Sie sind an dieser Abgabe nicht beteiligt. UnauthorizedSubmissionOwner: Sie sind an dieser Abgabe nicht beteiligt.
@ -354,6 +355,7 @@ DummyLoginTitle: Development-Login
CorrectorNormal: Normal CorrectorNormal: Normal
CorrectorMissing: Abwesend CorrectorMissing: Abwesend
CorrectorExcused: Entschuldigt 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 DayIsAHoliday tid@TermId date@Text: #{date} ist ein Feiertag
DayIsOutOfLecture tid@TermId date@Text: #{date} ist außerhalb der Vorlesungszeit des #{display tid} 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 AuthTagCorrector: Nutzer ist Korrektor
AuthTagTime: Zeitliche Einschränkungen sind erfüllt AuthTagTime: Zeitliche Einschränkungen sind erfüllt
AuthTagRegistered: Nutzer ist Kursteilnehmer AuthTagRegistered: Nutzer ist Kursteilnehmer
AuthTagParticipant: Nutzer ist mit Kurs assoziiert
AuthTagCapacity: Kapazität ist ausreichend AuthTagCapacity: Kapazität ist ausreichend
AuthTagEmpty: Kurs hat keine Teilnehmer AuthTagEmpty: Kurs hat keine Teilnehmer
AuthTagMaterials: Kursmaterialien sind freigegeben AuthTagMaterials: Kursmaterialien sind freigegeben

15
models/courses
View File

@ -34,7 +34,16 @@ Lecturer
course CourseId course CourseId
UniqueLecturer user course UniqueLecturer user course
CourseParticipant CourseParticipant
course CourseId course CourseId
user UserId user UserId
registration UTCTime registration UTCTime
UniqueParticipant user course 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) -- !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) -- !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) -- !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 -- !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 -- !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 -- !empty -- course this route is associated with has no participants whatsoever
@ -32,19 +33,19 @@
/favicon.ico FaviconR GET !free /favicon.ico FaviconR GET !free
/robots.txt RobotsR GET !free /robots.txt RobotsR GET !free
/ HomeR GET !free / HomeR GET !free
/users UsersR GET -- no tags, i.e. admins only /users UsersR GET -- no tags, i.e. admins only
/admin/test AdminTestR GET POST /users/#CryptoUUIDUser AdminUserR GET !development
/admin/user/#CryptoUUIDUser AdminUserR GET !development /users/#CryptoUUIDUser/hijack AdminHijackUserR POST !adminANDno-escalation
/admin/user/#CryptoUUIDUser/hijack AdminHijackUserR POST !adminANDno-escalation /admin/test AdminTestR GET POST
/admin/errMsg AdminErrMsgR GET POST /admin/errMsg AdminErrMsgR GET POST
/info VersionR GET !free /info VersionR GET !free
/help HelpR GET POST !free /help HelpR GET POST !free
/profile ProfileR GET POST !free /profile ProfileR GET POST !free
/profile/data ProfileDataR GET POST !free /profile/data ProfileDataR GET POST !free
/authpreds AuthPredsR GET POST !free /authpreds AuthPredsR GET POST !free
/term TermShowR GET !free /term TermShowR GET !free
/term/current TermCurrentR GET !free /term/current TermCurrentR GET !free
@ -66,7 +67,7 @@
/edit CEditR GET POST /edit CEditR GET POST
/delete CDeleteR GET POST !lecturerANDempty /delete CDeleteR GET POST !lecturerANDempty
/users CUsersR GET /users CUsersR GET
/user/#CryptoUUIDUser CUserR GET !development /users/#CryptoUUIDUser CUserR GET !lecturerANDparticipant
/correctors CHiWisR GET /correctors CHiWisR GET
/subs CCorrectionsR GET POST /subs CCorrectionsR GET POST
/ex SheetListR GET !registered !materials /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.^. CourseSchool E.==. E.val ssh
E.&&. course E.^. CourseShorthand E.==. E.val csh E.&&. course E.^. CourseShorthand E.==. E.val csh
return (E.countRows :: E.SqlExpr (E.Value Int64)) return (E.countRows :: E.SqlExpr (E.Value Int64))
guardMExceptT (c > 0) (unauthorizedI MsgUnauthorizedParticipant) guardMExceptT (c > 0) (unauthorizedI MsgUnauthorizedRegistered)
return Authorized return Authorized
r -> $unsupportedAuthPredicate AuthRegistered r 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 tagAccessPredicate AuthCapacity = APDB $ \route _ -> case route of
CourseR tid ssh csh _ -> maybeT (unauthorizedI MsgCourseNoCapacity) $ do CourseR tid ssh csh _ -> maybeT (unauthorizedI MsgCourseNoCapacity) $ do
Entity cid Course{..} <- MaybeT . getBy $ TermSchoolCourseShort tid ssh csh 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 :: TermId -> SchoolId -> CourseShorthand -> CryptoUUIDUser -> Handler Html
getCUserR _tid _ssh _csh uCId = do getCUserR _tid _ssh _csh uCId = do
-- Needs authorization check: -- Has authorization checks (OR):
-- --
-- - User is current member of course -- - User is current member of course
-- - User has submitted in course -- - User has submitted in course
-- - User is member of registered group for course -- - User is member of registered group for course
-- - User is corrector for course (?) -- - User is member of a tutorial for course
-- - User is lecturer for course (?) -- - User is corrector for course
-- - User is a tutor for course
-- - User is a lecturer for course
uid <- decrypt uCId uid <- decrypt uCId
User{..} <- runDB $ get404 uid User{..} <- runDB $ get404 uid
defaultLayout -- TODO defaultLayout -- TODO

10
src/Handler/Profile.hs
View File

@ -86,10 +86,10 @@ postProfileR = do
_ -> return () _ -> return ()
let formText = Nothing :: Maybe UniWorXMessage let formText = Nothing :: Maybe UniWorXMessage
actionUrl = ProfileR actionUrl = ProfileR
defaultLayout $ do defaultLayout $ do
setTitle . toHtml $ userIdent <> "'s User page" setTitle . toHtml $ userIdent <> "'s User page"
$(widgetFile "formPageI18n") $(widgetFile "formPageI18n")
postProfileDataR :: Handler Html postProfileDataR :: Handler Html
postProfileDataR = do postProfileDataR = do
@ -215,8 +215,8 @@ getProfileDataR = do
<*> mkSubmissionTable uid -- Tabelle mit allen Abgaben und Abgabe-Gruppen <*> mkSubmissionTable uid -- Tabelle mit allen Abgaben und Abgabe-Gruppen
<*> mkSubmissionGroupTable uid -- Tabelle mit allen Abgabegruppen <*> mkSubmissionGroupTable uid -- Tabelle mit allen Abgabegruppen
<*> mkCorrectionsTable uid -- Tabelle mit allen Korrektor-Aufgaben <*> mkCorrectionsTable uid -- Tabelle mit allen Korrektor-Aufgaben
let examTable = [whamlet| Klausuren werden momentan leider noch nicht unterstützt.|] let examTable = [whamlet| Klausuren werden momentan leider noch nicht unterstützt.|]
let ownTutorialTable = [whamlet|Übungsgruppen 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.|] let tutorialTable = [whamlet|Übungsgruppen werden momentan leider noch nicht unterstützt.|]
@ -304,7 +304,7 @@ mkEnrolledCoursesTable =
termCell <$> view (_dbrOutput . _1 . _entityVal . _courseTerm) termCell <$> view (_dbrOutput . _1 . _entityVal . _courseTerm)
, sortable (Just "school") (i18nCell MsgCourseSchool) . magnify (_dbrOutput . _1 . _entityVal) $ , sortable (Just "school") (i18nCell MsgCourseSchool) . magnify (_dbrOutput . _1 . _entityVal) $
schoolCell <$> view ( _courseTerm . re _Just) schoolCell <$> view ( _courseTerm . re _Just)
<*> view _courseSchool <*> view _courseSchool
, sortable (Just "course") (i18nCell MsgCourse) $ , sortable (Just "course") (i18nCell MsgCourse) $
courseCell <$> view (_dbrOutput . _1 . _entityVal) courseCell <$> view (_dbrOutput . _1 . _entityVal)
, sortable (Just "time") (i18nCell MsgRegistered) $ do , sortable (Just "time") (i18nCell MsgRegistered) $ do

2
src/Handler/Sheet.hs
View File

@ -722,7 +722,7 @@ correctorForm shid = do
, countTutView , countTutView
, FieldView , FieldView
{ fvLabel = text $ mr MsgCorrectors { fvLabel = text $ mr MsgCorrectors
, fvTooltip = Nothing , fvTooltip = Just $ toHtml $ mr MsgCorrectorStateTip
, fvId = "" , fvId = ""
, fvInput = Yesod.encodeCellTable tableDefault corrColonnade corrData >> mapM_ idField corrData >> mapM_ delField deletions' , fvInput = Yesod.encodeCellTable tableDefault corrColonnade corrData >> mapM_ idField corrData >> mapM_ delField deletions'
, fvErrors = Nothing , fvErrors = Nothing

1
src/Model/Types.hs
View File

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