feat(external-exams): plan for student grade access

messages/uniworx/de-de-formal.msg

@@ -414,6 +414,7 @@ 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.
 UnauthorizedExamOccurrenceRegistration: Anmeldung zur Klausur erfolgt nicht inkl. Raum/Termin.
+UnauthorizedExternalExamResult: Sie haben keine Ergebnisse in dieser Prüfung.
 UnauthorizedParticipant: Angegebener Benutzer ist nicht als Teilnehmer dieser Veranstaltung registriert.
 UnauthorizedParticipantSelf: Sie sind kein Teilnehmer dieser Veranstaltung.
 UnauthorizedApplicant: Angegebener Benutzer hat sich nicht für diese Veranstaltung beworben.

messages/uniworx/en-eu.msg

@@ -411,6 +411,7 @@ UnauthorizedRegistered: You are no participant in this course.
 UnauthorizedAllocationRegistered: You are no participant in this central allocation.
 UnauthorizedExamResult: You have no results in this exam.
 UnauthorizedExamOccurrenceRegistration: Registration for exam is not done including occurrence/room.
+UnauthorizedExternalExamResult: You have no results in this exam.
 UnauthorizedParticipant: The specified user is no participant of this course.
 UnauthorizedParticipantSelf: You are no participant of this course.
 UnauthorizedApplicant: The specified user is no applicant for this course.

routes

@@ -83,7 +83,7 @@
 /external-exam             EExamListR          GET             !lecturer !¬empty
 /external-exam/new         EExamNewR           GET POST        !lecturer
 /external-exam/#TermId/#SchoolId/#CourseName/#ExamName EExamR  !lecturer:
-  /                        EEShowR             GET             !exam-office
+  /                        EEShowR             GET             !exam-office !exam-result
   /edit                    EEEditR             GET POST
   /users                   EEUsersR            GET POST
   /grades                  EEGradesR           GET POST        !exam-office

src/Foundation.hs

@@ -895,6 +895,17 @@ tagAccessPredicate AuthExamResult = APDB $ \mAuthId route _ -> case route of
            E.&&. exam E.^. ExamName  E.==. E.val examn
     guardMExceptT (hasResult || hasPartResult) (unauthorizedI MsgUnauthorizedExamResult)
     return Authorized
+  EExamR tid ssh coursen examn _ -> $cachedHereBinary (mAuthId, tid, ssh, coursen, examn) . exceptT return return $ do
+    authId <- maybeExceptT AuthenticationRequired $ return mAuthId
+    hasResult <- $cachedHereBinary (authId, tid, ssh, coursen, examn) . lift . E.selectExists . E.from $ \(eexam `E.InnerJoin` eexamResult) -> do
+      E.on $ eexam E.^. ExternalExamId E.==. eexamResult E.^. ExternalExamResultExam
+      E.where_ $ eexamResult E.^. ExternalExamResultUser E.==. E.val authId
+           E.&&. eexam E.^. ExternalExamTerm E.==. E.val tid
+           E.&&. eexam E.^. ExternalExamSchool E.==. E.val ssh
+           E.&&. eexam E.^. ExternalExamCourseName E.==. E.val coursen
+           E.&&. eexam E.^. ExternalExamExamName E.==. E.val examn
+    guardMExceptT hasResult $ unauthorizedI MsgUnauthorizedExternalExamResult
+    return Authorized
   CourseR tid ssh csh _ -> exceptT return return $ do
     authId <- maybeExceptT AuthenticationRequired $ return mAuthId
     hasResult <- $cachedHereBinary (authId, tid, ssh, csh) . lift . E.selectExists . E.from $ \(course `E.InnerJoin` exam `E.InnerJoin` examResult) -> do
@@ -3288,6 +3299,7 @@ routeNormalizers =
   , ncMaterial
   , ncTutorial
   , ncExam
+  , ncExternalExam
   , verifySubmission
   , verifyCourseApplication
   , verifyCourseNews
@@ -3356,6 +3368,14 @@ routeNormalizers =
       Entity _ Exam{..} <- MaybeT . $cachedHereBinary (cid, examn) . lift . getBy $ UniqueExam cid examn
       caseChanged examn examName
       return $ route & typesUsing @RouteChildren @ExamName . filtered (== examn) .~ examName
+    ncExternalExam = maybeOrig $ \route -> do
+      EExamR tid ssh coursen examn _ <- return route
+      Entity _ ExternalExam{..} <- MaybeT . $cachedHereBinary (tid, ssh, coursen, examn) . lift . getBy $ UniqueExternalExam tid ssh coursen examn
+      caseChanged coursen externalExamCourseName
+      caseChanged examn externalExamExamName
+      return $ route
+        & typesUsing @RouteChildren @CourseName . filtered (== coursen) .~ externalExamCourseName
+        & typesUsing @RouteChildren @ExamName . filtered (== examn) .~ externalExamExamName
     verifySubmission = maybeOrig $ \route -> do
       CSubmissionR _tid _ssh _csh _shn cID sr <- return route
       sId <- $cachedHereBinary cID $ decrypt cID