diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg index 492a08b54..ef3910846 100644 --- a/messages/uniworx/de.msg +++ b/messages/uniworx/de.msg @@ -878,6 +878,7 @@ AuthTagTutor: Nutzer ist Tutor AuthTagTime: Zeitliche Einschränkungen sind erfüllt AuthTagCourseRegistered: Nutzer ist Kursteilnehmer AuthTagTutorialRegistered: Nutzer ist Tutoriumsteilnehmer +AuthTagExamRegistered: Nutzer ist Klausurteilnehmer AuthTagParticipant: Nutzer ist mit Kurs assoziiert AuthTagRegisterGroup: Nutzer ist nicht Mitglied eines anderen Tutoriums mit der selben Registrierungs-Gruppe AuthTagCapacity: Kapazität ist ausreichend @@ -1145,4 +1146,6 @@ ExamResult: Klausurergebnis ExamRegisteredSuccess exam@ExamName: Erfolgreich zur Klausur #{exam} angemeldet ExamDeregisteredSuccess exam@ExamName: Erfolgreich von der Klausur #{exam} abgemeldet -ExamRegistered: Angemeldet \ No newline at end of file +ExamRegistered: Angemeldet +ExamNotRegistered: Nicht angemeldet +ExamRegistration: Anmeldung \ No newline at end of file diff --git a/src/Foundation.hs b/src/Foundation.hs index 97dd384f5..21349c919 100644 --- a/src/Foundation.hs +++ b/src/Foundation.hs @@ -797,6 +797,33 @@ tagAccessPredicate AuthTutorialRegistered = APDB $ \mAuthId route _ -> case rout guardMExceptT (c > 0) (unauthorizedI MsgUnauthorizedRegistered) return Authorized r -> $unsupportedAuthPredicate AuthTutorialRegistered r +tagAccessPredicate AuthExamRegistered = APDB $ \mAuthId route _ -> case route of + CExamR tid ssh csh examn _ -> exceptT return return $ do + authId <- maybeExceptT AuthenticationRequired $ return mAuthId + [E.Value c] <- $cachedHereBinary (authId, tid, ssh, csh, examn) . lift . E.select . E.from $ \(course `E.InnerJoin` exam `E.InnerJoin` examRegistration) -> do + E.on $ exam E.^. ExamId E.==. examRegistration E.^. ExamRegistrationExam + E.on $ course E.^. CourseId E.==. exam E.^. ExamCourse + E.where_ $ examRegistration E.^. ExamRegistrationUser E.==. E.val authId + 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.&&. exam E.^. ExamName E.==. E.val examn + return (E.countRows :: E.SqlExpr (E.Value Int64)) + guardMExceptT (c > 0) (unauthorizedI MsgUnauthorizedRegistered) + return Authorized + CourseR tid ssh csh _ -> exceptT return return $ do + authId <- maybeExceptT AuthenticationRequired $ return mAuthId + [E.Value c] <- $cachedHereBinary (authId, tid, ssh, csh) . lift . E.select . E.from $ \(course `E.InnerJoin` exam `E.InnerJoin` examRegistration) -> do + E.on $ exam E.^. ExamId E.==. examRegistration E.^. ExamRegistrationExam + E.on $ course E.^. CourseId E.==. exam E.^. ExamCourse + E.where_ $ examRegistration E.^. ExamRegistrationUser E.==. E.val authId + E.&&. course E.^. CourseTerm E.==. E.val tid + 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 MsgUnauthorizedRegistered) + return Authorized + r -> $unsupportedAuthPredicate AuthExamRegistered r tagAccessPredicate AuthParticipant = APDB $ \_ route _ -> case route of CourseR tid ssh csh (CUserR cID) -> exceptT return return $ do let authorizedIfExists f = do diff --git a/src/Handler/Exam.hs b/src/Handler/Exam.hs index f44a78abf..5a7817339 100644 --- a/src/Handler/Exam.hs +++ b/src/Handler/Exam.hs @@ -634,7 +634,7 @@ getEShowR tid ssh csh examn = do cTime <- liftIO getCurrentTime mUid <- maybeAuthId - (Entity _ Exam{..}, parts, examVisible, (gradingVisible, gradingShown), (occurrenceAssignmentsVisible, occurrenceAssignmentsShown), results, result, occurrences) <- runDB $ do + (Entity _ Exam{..}, parts, examVisible, (gradingVisible, gradingShown), (occurrenceAssignmentsVisible, occurrenceAssignmentsShown), results, result, occurrences, (registered, mayRegister)) <- runDB $ do exam@(Entity eId Exam{..}) <- fetchExam tid ssh csh examn let examVisible = NTop (Just cTime) >= NTop examVisibleFrom @@ -671,9 +671,30 @@ getEShowR tid ssh csh examn = do let occurrences = map (over _2 E.unValue) occurrencesRaw - return (exam, parts, examVisible, (gradingVisible, gradingShown), (occurrenceAssignmentsVisible, occurrenceAssignmentsShown), results, result, occurrences) + registered <- for mUid $ existsBy . UniqueExamRegistration eId + mayRegister <- (== Authorized) <$> evalAccessDB (CExamR tid ssh csh examName ERegisterR) True + + return (exam, parts, examVisible, (gradingVisible, gradingShown), (occurrenceAssignmentsVisible, occurrenceAssignmentsShown), results, result, occurrences, (registered, mayRegister)) let examTimes = all (\(Entity _ ExamOccurrence{..}, _) -> examOccurrenceStart == examStart && examOccurrenceEnd == examEnd) occurrences + registerWidget + | Just isRegistered <- registered + , mayRegister = Just $ do + (examRegisterForm, examRegisterEnctype) <- liftHandlerT . generateFormPost . buttonForm' $ bool [BtnRegister] [BtnDeregister] isRegistered + [whamlet| +
+ $if isRegistered + _{MsgExamRegistered} + $else + _{MsgExamNotRegistered} + |] + wrapForm examRegisterForm def + { formAction = Just . SomeRoute $ CExamR tid ssh csh examName ERegisterR + , formEncoding = examRegisterEnctype + , formSubmit = FormNoSubmit + } + | fromMaybe False registered = Just [whamlet|_{MsgExamRegistered}|] + | otherwise = Nothing let heading = prependCourseTitle tid ssh csh $ CI.original examName diff --git a/src/Model/Types/Security.hs b/src/Model/Types/Security.hs index 1c1919fdf..805e7d96d 100644 --- a/src/Model/Types/Security.hs +++ b/src/Model/Types/Security.hs @@ -42,6 +42,7 @@ data AuthTag -- sortiert nach gewünschter Reihenfolge auf /authpreds, d.h. Prä | AuthTutor | AuthCourseRegistered | AuthTutorialRegistered + | AuthExamRegistered | AuthParticipant | AuthTime | AuthMaterials diff --git a/templates/exam-show.hamlet b/templates/exam-show.hamlet index 36625be20..3603fee38 100644 --- a/templates/exam-show.hamlet +++ b/templates/exam-show.hamlet @@ -81,6 +81,10 @@ $maybe desc <- examDescription \ ^{isVisible False}