From 9d709ca400ab39957e0c5b6b7a4c466b4587dc83 Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Wed, 16 Oct 2019 17:11:34 +0200 Subject: [PATCH] fix(rights): split applicant off participant --- messages/uniworx/de.msg | 5 ++++- routes | 2 +- src/Foundation.hs | 34 ++++++++++++++++++++++------------ src/Model/Types/Security.hs | 1 + 4 files changed, 28 insertions(+), 14 deletions(-) diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg index 7117498a4..0b65e07f1 100644 --- a/messages/uniworx/de.msg +++ b/messages/uniworx/de.msg @@ -385,7 +385,9 @@ UnauthorizedRegistered: Sie sind nicht als Teilnehmer für diese Veranstaltung r UnauthorizedAllocationRegistered: Sie sind nicht als Teilnehmer für diese Zentralanmeldung registriert. UnauthorizedExamResult: Sie haben keine Ergebnisse in dieser Prüfung. UnauthorizedParticipant: Angegebener Benutzer ist nicht als Teilnehmer dieser Veranstaltung registriert. -UnauthorizedCourseNewsParticipant: Sie sind kein Teilnehmer dieser Veranstaltung. +UnauthorizedParticipantSelf: Sie sind kein Teilnehmer dieser Veranstaltung. +UnauthorizedApplicant: Angegebener Benutzer hat sich nicht für diese Veranstaltung beworben. +UnauthorizedApplicantSelf: Sie sind kein Bewerber für diese Veranstaltung. UnauthorizedCourseTime: Dieses Kurs erlaubt momentan keine Anmeldungen. UnauthorizedAllocationRegisterTime: Diese Zentralanmeldung erlaubt momentan keine Bewerbungen. UnauthorizedSheetTime: Dieses Übungsblatt ist momentan nicht freigegeben. @@ -1138,6 +1140,7 @@ AuthTagTutorialRegistered: Nutzer ist Tutoriumsteilnehmer AuthTagExamRegistered: Nutzer ist Prüfungsteilnehmer AuthTagExamResult: Nutzer hat Prüfungsergebnisse AuthTagParticipant: Nutzer ist mit Kurs assoziiert +AuthTagApplicant: Nutzer ist mit Bewerber zum Kurs AuthTagRegisterGroup: Nutzer ist nicht Mitglied eines anderen Tutoriums mit der selben Registrierungs-Gruppe AuthTagCapacity: Kapazität ist ausreichend AuthTagEmpty: Kurs hat keine Teilnehmer diff --git a/routes b/routes index 2c9d8ea3b..582834521 100644 --- a/routes +++ b/routes @@ -113,7 +113,7 @@ /users CUsersR GET POST !/users/new CAddUserR GET POST !lecturerANDallocation-time !/users/invite CInviteR GET POST - /users/#CryptoUUIDUser CUserR GET POST !lecturerANDparticipant + /users/#CryptoUUIDUser CUserR GET POST !lecturerANDparticipant !lecturerANDapplicant /correctors CHiWisR GET /communication CCommR GET POST /notes CNotesR GET POST !corrector -- THIS route is used to check for overall course corrector access! diff --git a/src/Foundation.hs b/src/Foundation.hs index 5738dabf9..d9f75af5a 100644 --- a/src/Foundation.hs +++ b/src/Foundation.hs @@ -1145,7 +1145,7 @@ tagAccessPredicate AuthAllocationRegistered = APDB $ \mAuthId route _ -> case ro return Authorized r -> $unsupportedAuthPredicate AuthAllocationRegistered r tagAccessPredicate AuthParticipant = APDB $ \mAuthId route _ -> case route of - CNewsR tid ssh csh cID _ -> maybeT (unauthorizedI MsgUnauthorizedCourseNewsParticipant) $ do + CNewsR tid ssh csh cID _ -> maybeT (unauthorizedI MsgUnauthorizedParticipantSelf) $ do nId <- catchIfMaybeT (const True :: CryptoIDError -> Bool) $ decrypt cID CourseNews{courseNewsParticipantsOnly} <- $cachedHereBinary nId . MaybeT $ get nId if | courseNewsParticipantsOnly -> do @@ -1163,7 +1163,6 @@ tagAccessPredicate AuthParticipant = APDB $ \mAuthId route _ -> case route of where isCourseParticipant tid ssh csh participant = do - cTime <- liftIO getCurrentTime let authorizedIfExists :: E.From a => (a -> E.SqlQuery b) -> ExceptT AuthResult DB () authorizedIfExists = flip whenExceptT Authorized <=< lift . E.selectExists . E.from @@ -1222,18 +1221,29 @@ 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 applicant for this course - $cachedHereBinary (participant, tid, ssh, csh) . authorizedIfExists $ \((course `E.InnerJoin` courseApplication) `E.LeftOuterJoin` allocation) -> do - E.on $ allocation E.?. AllocationId E.==. courseApplication E.^. CourseApplicationAllocation - E.on $ course E.^. CourseId E.==. courseApplication E.^. CourseApplicationCourse - E.where_ $ courseApplication E.^. CourseApplicationUser 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 - E.where_ $ E.maybe E.true (E.maybe E.false $ \f -> f E.<=. E.val cTime) (allocation E.?. AllocationStaffAllocationFrom) - E.&&. E.maybe E.true (E.maybe E.true $ \t -> t E.>=. E.val cTime) (allocation E.?. AllocationStaffAllocationTo) return () +tagAccessPredicate AuthApplicant = APDB $ \mAuthId route _ -> case route of + CourseR tid ssh csh (CUserR cID) -> maybeT (unauthorizedI MsgUnauthorizedApplicant) $ do + uid <- catchIfMaybeT (const True :: CryptoIDError -> Bool) $ decrypt cID + isApplicant <- isCourseApplicant tid ssh csh uid + guard isApplicant + return Authorized + + CourseR tid ssh csh _ -> maybeT (unauthorizedI MsgUnauthorizedApplicantSelf) $ do + uid <- hoistMaybe mAuthId + isApplicant <- isCourseApplicant tid ssh csh uid + guard isApplicant + return Authorized + + r -> $unsupportedAuthPredicate AuthApplicant r + where + isCourseApplicant tid ssh csh uid = lift . $cachedHereBinary (uid, tid, ssh, csh) . E.selectExists . E.from $ \(course `E.InnerJoin` courseApplication) -> do + E.on $ course E.^. CourseId E.==. courseApplication E.^. CourseApplicationCourse + E.where_ $ courseApplication E.^. CourseApplicationUser E.==. E.val uid + E.&&. course E.^. CourseTerm E.==. E.val tid + E.&&. course E.^. CourseSchool E.==. E.val ssh + E.&&. course E.^. CourseShorthand E.==. E.val csh tagAccessPredicate AuthCapacity = APDB $ \_ route _ -> case route of CTutorialR tid ssh csh tutn _ -> maybeT (unauthorizedI MsgTutorialNoCapacity) $ do cid <- $cachedHereBinary (tid, ssh, csh) . MaybeT . getKeyBy $ TermSchoolCourseShort tid ssh csh diff --git a/src/Model/Types/Security.hs b/src/Model/Types/Security.hs index 1be2ce552..66a01cf6b 100644 --- a/src/Model/Types/Security.hs +++ b/src/Model/Types/Security.hs @@ -51,6 +51,7 @@ data AuthTag -- sortiert nach gewünschter Reihenfolge auf /authpreds, d.h. Prä | AuthExamRegistered | AuthExamResult | AuthParticipant + | AuthApplicant | AuthTime | AuthStaffTime | AuthAllocationTime