feat(sheets): require exam registration

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.

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.

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

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
+      /                         SubShowR       GET POST        !ownerANDtimeANDuser-submissionsANDsubmission-groupANDexam-registered !ownerANDread !correctorANDread
-      /delete                   SubDelR        GET POST        !ownerANDtimeANDuser-submissions
+      /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            SZipR          GET             !timeANDcourse-registeredANDexam-registered !timeANDmaterialsANDexam-registered !corrector !timeANDtutor
-    !/#SheetFileType/*FilePath  SFileR         GET             !timeANDcourse-registered !timeANDmaterials !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:

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

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

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 :: CourseId -> Maybe SheetId -> Maybe SheetForm -> Form SheetForm
-makeSheetForm msId template = identifyForm FIDsheet . validateForm validateSheet $ \html -> do
+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)

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

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

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)

templates/i18n/changelog/de-de-formal.hamlet

@@ -1,5 +1,12 @@
 $newline never
 <dl .deflist>
+  <dt .deflist__dt>
+    ^{formatGregorianW 2020 07 20}
+  <dd .deflist__dd>
+    <ul>
+      <li>
+        Abgabe und Download von einzelnen Übungsblättern kann auf Prüfungsteilnehmer beschränkt werden.
+  
   <dt .deflist__dt>
     ^{formatGregorianW 2020 06 17}
   <dd .deflist__dd>

templates/i18n/changelog/en-eu.hamlet

@@ -1,5 +1,12 @@
 $newline never
 <dl .deflist>
+  <dt .deflist__dt>
+    ^{formatGregorianW 2020 07 20}
+  <dd .deflist__dd>
+    <ul>
+      <li>
+        Submission for and download of exercise sheets may be restricted to participants who are registered for an exam.
+  
   <dt .deflist__dt>
     ^{formatGregorianW 2020 06 17}
   <dd .deflist__dd>

templates/sheetShow.hamlet

@@ -35,8 +35,20 @@ $maybe descr <- sheetDescription sheet
     $maybe solution <- solutionFrom <* guard hasSolution
       <dt .deflist__dt>_{MsgSheetSolutionFrom}
       <dd .deflist__dd>#{solution}
+    $maybe (_, _, _, examn) <- mRequiredExam
+      <dt .deflist__dt>
+        _{MsgSheetShowRequiredExam}
+        <p .deflist__explanation>
+          _{MsgSheetSubmissionExamRegistrationRequired}
+      <dd .deflist__dd>
+        $maybe url <- mRequiredExamLink
+          <a href=@{url}>
+            #{examn}
+        $nothing
+          #{examn}
     <dt .deflist__dt>_{MsgSheetSubmissionMode}
-    <dd .deflist__dd>_{classifySubmissionMode (sheetSubmissionMode sheet)}
+    <dd .deflist__dd>
+      _{classifySubmissionMode (sheetSubmissionMode sheet)}
       $case sheetSubmissionMode sheet
         $of SubmissionMode True _
           ^{messageTooltip submissionTip}
@@ -63,3 +75,6 @@ $if hasFiles
   <section>
     <h2>^{simpleLinkI (SomeMessage MsgSheetFiles) zipLink}
     ^{fileTable}
+$elseif fromMaybe False mMissingExamRegistration
+  <section>
+    ^{notificationWidget NotificationBroad Warning (i18n MsgSheetFilesExamRegistrationRequired)}