fix(rights): split applicant off participant

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

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!

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

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