From d770afd2c6ade597fa2b8ecf229c312f1ee6be56 Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Mon, 20 Jul 2020 14:26:55 +0200 Subject: [PATCH] feat(sheets): require exam registration --- messages/uniworx/de-de-formal.msg | 8 ++++++++ messages/uniworx/en-eu.msg | 8 ++++++++ models/sheets.model | 1 + routes | 16 ++++++++-------- src/Foundation.hs | 20 ++++++++++++++++++-- src/Handler/Sheet/Edit.hs | 4 +++- src/Handler/Sheet/Form.hs | 6 ++++-- src/Handler/Sheet/New.hs | 1 + src/Handler/Sheet/Show.hs | 12 ++++++++++++ src/Handler/Utils/Form.hs | 9 +++++++++ templates/i18n/changelog/de-de-formal.hamlet | 7 +++++++ templates/i18n/changelog/en-eu.hamlet | 7 +++++++ templates/sheetShow.hamlet | 17 ++++++++++++++++- 13 files changed, 102 insertions(+), 14 deletions(-) diff --git a/messages/uniworx/de-de-formal.msg b/messages/uniworx/de-de-formal.msg index 19afb89c5..93c47f059 100644 --- a/messages/uniworx/de-de-formal.msg +++ b/messages/uniworx/de-de-formal.msg @@ -332,6 +332,12 @@ SheetPseudonym: Persönliches Abgabe-Pseudonym SheetGeneratePseudonym: Generieren SheetAnonymousCorrection: Anonymisierte Korrektur SheetAnonymousCorrectionTip: Wenn die Korrektur anonymisiert erfolgt, können Korrektoren die ihnen zugeteilten Abgaben nicht bestimmten Studierenden zuordnen (Name, Matrikelnummer und feste Abgabegruppe der Abgebenden werden versteckt) +SheetRequireExam: Anmeldung zu einer Prüfung voraussetzen? +SheetRequireExamTip: Wenn die Anmeldung zu einer Prüfung vorausgesetzt wird, können nur Kursteilnehmer abgeben, die zum Zeitpunkt der Abgabe auch zur gewählten Prüfung angemeldet sind. Auch der Download von Übungsblatt-Dateien wird nur zur Prüfung angemeldeten Kursteilnehmern erlaubt. +SheetRequiredExam: Prüfung +SheetShowRequiredExam: Vorausgesetze Prüfungsanmeldung +SheetSubmissionExamRegistrationRequired: Um die Angabe für dieses Übungsblatt herunterzuladen oder Abzugeben ist eine Anmeldung zur genannten Prüfung erforderlich. +SheetFilesExamRegistrationRequired: Um die Angabe für dieses Übungsblatt herunterzuladen oder Abzugeben ist eine Anmeldung zu der oben genannten Prüfung erforderlich. SheetArchiveFileTypeDirectoryExercise: aufgabenstellung SheetArchiveFileTypeDirectoryHint: hinweis @@ -452,6 +458,8 @@ UnauthorizedExamCorrector: Sie sind nicht als Korrektor für diese Prüfung eing UnauthorizedExamCorrectorGrade: Sie haben nicht die Berechtigung für diese Prüfung Gesamtergebnisse einzutragen. UnauthorizedCorrectorAny: Sie sind nicht als Korrektor für eine Veranstaltung eingetragen. UnauthorizedRegistered: Sie sind nicht als Teilnehmer für diese Veranstaltung registriert. +UnauthorizedRegisteredExam: Sie sind nicht als Teilnehmer für diese Prüfung registriert. +UnauthorizedRegisteredAnyExam: Sie sind nicht als Teilnehmer für eine Prüfung registriert. UnauthorizedAllocationRegistered: Sie sind nicht als Teilnehmer für diese Zentralanmeldung registriert. UnauthorizedExamResult: Sie haben keine Ergebnisse in dieser Prüfung. UnauthorizedExamOccurrenceRegistration: Anmeldung zur Prüfung erfolgt nicht inkl. Raum/Termin. diff --git a/messages/uniworx/en-eu.msg b/messages/uniworx/en-eu.msg index 584f680d2..e7cf339ce 100644 --- a/messages/uniworx/en-eu.msg +++ b/messages/uniworx/en-eu.msg @@ -331,6 +331,12 @@ SheetPseudonym: Personal pseudonym SheetGeneratePseudonym: Generate SheetAnonymousCorrection: Anonymized correction SheetAnonymousCorrectionTip: If correction is anonymized, correctors cannot see which students are involved in submissions that are assigned to them (names, matriculation numbers, and registered submission groups are hidden) +SheetRequireExam: Require registration for an exam? +SheetRequireExamTip: If registration for an exam is required, only course participants that are registered for that exam at the time of submission will be allowed to create submission. Download of sheet files will also be restricted to course participants registered for the exam. +SheetRequiredExam: Exam +SheetShowRequiredExam: Required exam registration +SheetSubmissionExamRegistrationRequired: Registration for the specified exam is required to download files associated with this exercise sheet and to submit. +SheetFilesExamRegistrationRequired: To download files for this exercise sheet or to submit you must first register for the exam mentioned above. SheetArchiveFileTypeDirectoryExercise: exercise SheetArchiveFileTypeDirectoryHint: hint @@ -450,6 +456,8 @@ UnauthorizedExamCorrector: You are no corrector for this exam. UnauthorizedExamCorrectorGrade: You may not enter overall exam achievements for this exam. UnauthorizedCorrectorAny: You are no corrector for any course. UnauthorizedRegistered: You are no participant in this course. +UnauthorizedRegisteredExam: You are not registered for this exam. +UnauthorizedRegisteredAnyExam: You are not registered for an exam. 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. diff --git a/models/sheets.model b/models/sheets.model index 0f674b67b..6b6112db0 100644 --- a/models/sheets.model +++ b/models/sheets.model @@ -13,6 +13,7 @@ Sheet -- exercise sheet for a given course submissionMode SubmissionMode -- Submission upload by students and/or through tutors? autoDistribute Bool default=false -- Should correctors be assigned submissions automagically? anonymousCorrection Bool default=true + requireExamRegistration ExamId Maybe -- Students may only submit if they are registered for the given exam CourseSheet course name deriving Generic SheetEdit -- who edited when a row in table "Course", kept indefinitely diff --git a/routes b/routes index 81e11801b..54e9af960 100644 --- a/routes +++ b/routes @@ -147,26 +147,26 @@ /sheet/unassigned SheetOldUnassignedR GET /sheet/#SheetName SheetR: /show SShowR GET !timeANDcourse-registered !timeANDmaterials !corrector !timeANDtutor - /show/download SArchiveR GET !timeANDcourse-registered !timeANDmaterials !corrector !timeANDtutor + /show/download SArchiveR GET !timeANDcourse-registeredANDexam-registered !timeANDmaterialsANDexam-registered !corrector !timeANDtutor /edit SEditR GET POST /delete SDelR GET POST /subs SSubsR GET POST -- for lecturer only - !/subs/new SubmissionNewR GET POST !timeANDcourse-registeredANDuser-submissionsANDsubmission-group + !/subs/new SubmissionNewR GET POST !timeANDcourse-registeredANDuser-submissionsANDsubmission-groupANDexam-registered !/subs/own SubmissionOwnR GET !free -- just redirect !/subs/assign SAssignR GET POST !lecturerANDtime /subs/#CryptoFileNameSubmission SubmissionR: - / SubShowR GET POST !ownerANDtimeANDuser-submissionsANDsubmission-group !ownerANDread !correctorANDread - /delete SubDelR GET POST !ownerANDtimeANDuser-submissions + / SubShowR GET POST !ownerANDtimeANDuser-submissionsANDsubmission-groupANDexam-registered !ownerANDread !correctorANDread + /delete SubDelR GET POST !ownerANDtimeANDuser-submissionsANDexam-registered /assign SubAssignR GET POST !lecturerANDtime /correction CorrectionR GET POST !corrector !ownerANDreadANDrated - /invite SInviteR GET POST !ownerANDtimeANDuser-submissionsANDsubmission-group + /invite SInviteR GET POST !ownerANDtimeANDuser-submissionsANDsubmission-groupANDexam-registered !/#SubmissionFileType SubArchiveR GET !owner !corrector !/#SubmissionFileType/*FilePath SubDownloadR GET !owner !corrector /iscorrector SIsCorrR GET !corrector -- Route is used to check for corrector access to this sheet - /pseudonym SPseudonymR GET POST !course-registeredANDcorrector-submissions + /pseudonym SPseudonymR GET POST !course-registeredANDcorrector-submissionsANDexam-registered /corrector-invite/ SCorrInviteR GET POST - !/#SheetFileType SZipR GET !timeANDcourse-registered !timeANDmaterials !corrector !timeANDtutor - !/#SheetFileType/*FilePath SFileR GET !timeANDcourse-registered !timeANDmaterials !corrector !timeANDtutor + !/#SheetFileType SZipR GET !timeANDcourse-registeredANDexam-registered !timeANDmaterialsANDexam-registered !corrector !timeANDtutor + !/#SheetFileType/*FilePath SFileR GET !timeANDcourse-registeredANDexam-registered !timeANDmaterialsANDexam-registered !corrector !timeANDtutor /file MaterialListR GET !course-registered !materials !corrector !tutor /file/new MaterialNewR GET POST /file/#MaterialName MaterialR: diff --git a/src/Foundation.hs b/src/Foundation.hs index f1041367a..284fe8ae1 100644 --- a/src/Foundation.hs +++ b/src/Foundation.hs @@ -1087,7 +1087,23 @@ tagAccessPredicate AuthExamRegistered = APDB $ \mAuthId route _ -> case route of E.&&. course E.^. CourseSchool E.==. E.val ssh E.&&. course E.^. CourseShorthand E.==. E.val csh E.&&. exam E.^. ExamName E.==. E.val examn - guardMExceptT hasRegistration (unauthorizedI MsgUnauthorizedRegistered) + guardMExceptT hasRegistration $ unauthorizedI MsgUnauthorizedRegisteredExam + return Authorized + CSheetR tid ssh csh shn _ -> exceptT return return $ do + requiredExam' <- $cachedHereBinary (tid, ssh, csh, shn) . lift . E.selectMaybe . E.from $ \(course `E.InnerJoin` sheet) -> do + E.on $ sheet E.^. SheetCourse E.==. course E.^. CourseId + E.where_ $ course E.^. CourseTerm E.==. E.val tid + E.&&. course E.^. CourseSchool E.==. E.val ssh + E.&&. course E.^. CourseShorthand E.==. E.val csh + E.&&. sheet E.^. SheetName E.==. E.val shn + return $ sheet E.^. SheetRequireExamRegistration + requiredExam <- maybeMExceptT (unauthorizedI MsgUnauthorizedRegisteredExam) . return $ E.unValue <$> requiredExam' + whenIsJust requiredExam $ \eId -> do + authId <- maybeExceptT AuthenticationRequired $ return mAuthId + isRegistered <- $cachedHereBinary (authId, eId) . lift . E.selectExists . E.from $ \examRegistration -> + E.where_ $ examRegistration E.^. ExamRegistrationExam E.==. E.val eId + E.&&. examRegistration E.^. ExamRegistrationUser E.==. E.val authId + guardMExceptT isRegistered $ unauthorizedI MsgUnauthorizedRegisteredExam return Authorized CourseR tid ssh csh _ -> exceptT return return $ do authId <- maybeExceptT AuthenticationRequired $ return mAuthId @@ -1098,7 +1114,7 @@ tagAccessPredicate AuthExamRegistered = 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 - guardMExceptT hasRegistration (unauthorizedI MsgUnauthorizedRegistered) + guardMExceptT hasRegistration $ unauthorizedI MsgUnauthorizedRegisteredAnyExam return Authorized r -> $unsupportedAuthPredicate AuthExamRegistered r tagAccessPredicate AuthExamResult = APDB $ \mAuthId route _ -> case route of diff --git a/src/Handler/Sheet/Edit.hs b/src/Handler/Sheet/Edit.hs index 66d1782d3..8a6510129 100644 --- a/src/Handler/Sheet/Edit.hs +++ b/src/Handler/Sheet/Edit.hs @@ -52,6 +52,7 @@ postSEditR tid ssh csh shn = do , sfAutoDistribute = sheetAutoDistribute , sfAnonymousCorrection = sheetAnonymousCorrection , sfCorrectors = currentLoads + , sfRequireExamRegistration = sheetRequireExamRegistration } let action = uniqueReplace sid -- More specific error message for edit old sheet could go here by using myReplaceUnique instead @@ -62,7 +63,7 @@ handleSheetEdit tid ssh csh msId template dbAction = do let mbshn = sfName <$> template aid <- requireAuthId cid <- runDB $ getKeyBy404 $ TermSchoolCourseShort tid ssh csh - ((res,formWidget), formEnctype) <- runFormPost $ makeSheetForm msId template + ((res,formWidget), formEnctype) <- runFormPost $ makeSheetForm cid msId template case res of (FormSuccess SheetForm{..}) -> do saveOkay <- runDBJobs $ do @@ -82,6 +83,7 @@ handleSheetEdit tid ssh csh msId template dbAction = do , sheetSubmissionMode = sfSubmissionMode , sheetAutoDistribute = sfAutoDistribute , sheetAnonymousCorrection = sfAnonymousCorrection + , sheetRequireExamRegistration = sfRequireExamRegistration } mbsid <- dbAction newSheet case mbsid of diff --git a/src/Handler/Sheet/Form.hs b/src/Handler/Sheet/Form.hs index 8492aa4e0..82a710a6f 100644 --- a/src/Handler/Sheet/Form.hs +++ b/src/Handler/Sheet/Form.hs @@ -27,6 +27,7 @@ type Loads = Map (Either UserEmail UserId) (InvitationData SheetCorrector) data SheetForm = SheetForm { sfName :: SheetName , sfDescription :: Maybe Html + , sfRequireExamRegistration :: Maybe ExamId , sfSheetF, sfHintF, sfSolutionF, sfMarkingF :: Maybe FileUploads , sfVisibleFrom :: Maybe UTCTime , sfActiveFrom :: Maybe UTCTime @@ -51,8 +52,8 @@ getFtIdMap sId = do return sheetFile return $ partitionFileType [ (sheetFileType, sf ^. _FileReference . _1) | Entity _ sf@SheetFile{..} <- allSheetFiles ] -makeSheetForm :: Maybe SheetId -> Maybe SheetForm -> Form SheetForm -makeSheetForm msId template = identifyForm FIDsheet . validateForm validateSheet $ \html -> do +makeSheetForm :: CourseId -> Maybe SheetId -> Maybe SheetForm -> Form SheetForm +makeSheetForm cId msId template = identifyForm FIDsheet . validateForm validateSheet $ \html -> do oldFileIds <- (return.) <$> case msId of Nothing -> return $ partitionFileType mempty (Just sId) -> liftHandler $ runDB $ getFtIdMap sId @@ -61,6 +62,7 @@ makeSheetForm msId template = identifyForm FIDsheet . validateForm validateSheet flip (renderAForm FormStandard) html $ SheetForm <$> areq (textField & cfStrip & cfCI) (fslI MsgSheetName) (sfName <$> template) <*> aopt htmlField (fslI MsgSheetDescription) (sfDescription <$> template) + <*> optionalActionA (apreq (examField Nothing cId) (fslI MsgSheetRequiredExam) (sfRequireExamRegistration =<< template)) (fslI MsgSheetRequireExam & setTooltip MsgSheetRequireExamTip) (is _Just . sfRequireExamRegistration <$> template) <* aformSection MsgSheetFormFiles <*> aopt (multiFileField $ oldFileIds SheetExercise) (fslI MsgSheetExercise) (sfSheetF <$> template) <*> aopt (multiFileField $ oldFileIds SheetHint) (fslI MsgSheetHint) (sfHintF <$> template) diff --git a/src/Handler/Sheet/New.hs b/src/Handler/Sheet/New.hs index 64fa4624a..77cbb16a5 100644 --- a/src/Handler/Sheet/New.hs +++ b/src/Handler/Sheet/New.hs @@ -64,6 +64,7 @@ postSheetNewR tid ssh csh = do , sfAutoDistribute = sheetAutoDistribute , sfCorrectors = loads , sfAnonymousCorrection = sheetAnonymousCorrection + , sfRequireExamRegistration = Nothing } _other -> Nothing let action newSheet = -- More specific error message for new sheet could go here, if insertUnique returns Nothing diff --git a/src/Handler/Sheet/Show.hs b/src/Handler/Sheet/Show.hs index 1431df5da..1fd3763e1 100644 --- a/src/Handler/Sheet/Show.hs +++ b/src/Handler/Sheet/Show.hs @@ -103,6 +103,18 @@ getSShowR tid ssh csh shn = do , formEncoding = generateEnctype , formSubmit = FormNoSubmit } + mRequiredExam <- fmap join . for (sheetRequireExamRegistration sheet) $ \eId -> fmap (fmap $(E.unValueN 4)) . runDB . E.selectMaybe . E.from $ \(exam `E.InnerJoin` course) -> do + E.on $ exam E.^. ExamCourse E.==. course E.^. CourseId + E.where_ $ exam E.^. ExamId E.==. E.val eId + return (course E.^. CourseTerm, course E.^. CourseSchool, course E.^. CourseShorthand, exam E.^. ExamName) + mRequiredExamLink <- runMaybeT $ do + (etid, essh, ecsh, examn) <- hoistMaybe mRequiredExam + let eUrl = CExamR etid essh ecsh examn EShowR + guardM $ hasReadAccessTo eUrl + return eUrl + mMissingExamRegistration <- for (sheetRequireExamRegistration sheet) $ \eId -> maybeT (return True) $ do + uid <- MaybeT maybeAuthId + lift . fmap not . runDB $ exists [ ExamRegistrationExam ==. eId, ExamRegistrationUser ==. uid ] defaultLayout $ do setTitleI $ prependCourseTitle tid ssh csh $ SomeMessage shn diff --git a/src/Handler/Utils/Form.hs b/src/Handler/Utils/Form.hs index c9d238e1f..4018bbb32 100644 --- a/src/Handler/Utils/Form.hs +++ b/src/Handler/Utils/Form.hs @@ -1765,6 +1765,15 @@ examPassedGradeField :: forall m. examPassedGradeField = hoistField liftHandler . selectField $ (<>) <$> (fmap Right <$> optionsFinite) <*> (fmap Left <$> optionsFinite) +examField :: forall m. + ( MonadHandler m + , HandlerSite m ~ UniWorX + ) + => Maybe (SomeMessage UniWorX) -> CourseId -> Field m ExamId +examField optMsg cId = hoistField liftHandler . selectField' optMsg . (fmap $ fmap entityKey) $ + optionsPersistCryptoId [ExamCourse ==. cId] [Asc ExamName] examName + + data CsvFormatOptions' = CsvFormatOptionsPreset' CsvPreset | CsvFormatOptionsCustom' deriving (Eq, Ord, Read, Show, Generic, Typeable) diff --git a/templates/i18n/changelog/de-de-formal.hamlet b/templates/i18n/changelog/de-de-formal.hamlet index d079ca5fa..38a1ddeec 100644 --- a/templates/i18n/changelog/de-de-formal.hamlet +++ b/templates/i18n/changelog/de-de-formal.hamlet @@ -1,5 +1,12 @@ $newline never
+
+ ^{formatGregorianW 2020 07 20} +
+