diff --git a/messages/uniworx/de-de-formal.msg b/messages/uniworx/de-de-formal.msg index 1c6a746ae..030c292fc 100644 --- a/messages/uniworx/de-de-formal.msg +++ b/messages/uniworx/de-de-formal.msg @@ -2997,6 +2997,9 @@ PersonalisedSheetFilesIgnored count@Int64: Es #{pluralDE count "wurde" "wurden"} PersonalisedSheetFilesIgnoredIntro: Es wurden die folgenden Dateien ignoriert: CourseUserHasPersonalisedSheetFilesFilter: Teilnehmer hat personalisierte Übungsblatt-Dateien für SheetPersonalisedFilesUsersList: Liste von Teilnehmern mit personalisierten Übungsblatt-Dateien +PersonalisedSheetFilesDownloadRestrictByExamNone: Keine Einschränkung +PersonalisedSheetFilesDownloadRestrictByExam: Nur Prüfungsteilnehmer +PersonalisedSheetFilesDownloadRestrictByExamTip: Sollen nur personalisierte Übungsblatt-Dateien exportiert werden, für jene Kursteilnehmer, die auch Teilnehmer einer bestimmten Prüfung sind? AdminCrontabNotGenerated: (Noch) keine Crontab generiert CronMatchAsap: ASAP diff --git a/messages/uniworx/en-eu.msg b/messages/uniworx/en-eu.msg index 5a5030342..d4dab1a62 100644 --- a/messages/uniworx/en-eu.msg +++ b/messages/uniworx/en-eu.msg @@ -2998,6 +2998,9 @@ PersonalisedSheetFilesIgnored count: #{count} uploaded #{pluralEN count "file wa PersonalisedSheetFilesIgnoredIntro: The following files were ignored: CourseUserHasPersonalisedSheetFilesFilter: Participant has personalised sheet files for SheetPersonalisedFilesUsersList: List of course participants who have personalised sheet files +PersonalisedSheetFilesDownloadRestrictByExamNone: No restriction +PersonalisedSheetFilesDownloadRestrictByExam: Restrict to exam participants +PersonalisedSheetFilesDownloadRestrictByExamTip: Only download personalised sheet files for participants also registered to a certain exam? AdminCrontabNotGenerated: Crontab not (yet) generated CronMatchAsap: ASAP diff --git a/src/Handler/Course/Users.hs b/src/Handler/Course/Users.hs index 6431d3c7d..0115cf78a 100644 --- a/src/Handler/Course/Users.hs +++ b/src/Handler/Course/Users.hs @@ -681,7 +681,7 @@ postCUsersR tid ssh csh = do shId <- runDB . getKeyBy404 $ CourseSheet cid shn archiveName <- fmap (flip addExtension (unpack extensionZip) . unpack) . ap getMessageRender . pure $ MsgPersonalisedSheetFilesArchiveName courseTerm courseSchool courseShorthand shn - sendResponse <=< serveZipArchive' archiveName $ sourcePersonalisedSheetFiles cid (Just shId) (Just selectedUsers) anonMode + sendResponse <=< serveZipArchive' archiveName $ sourcePersonalisedSheetFiles cid (Just shId) (Just selectedUsers) anonMode Set.empty let headingLong = [whamlet|_{MsgMenuCourseMembers} #{courseName} #{tid}|] diff --git a/src/Handler/Sheet/PersonalisedFiles.hs b/src/Handler/Sheet/PersonalisedFiles.hs index 53f3b41f0..b53829933 100644 --- a/src/Handler/Sheet/PersonalisedFiles.hs +++ b/src/Handler/Sheet/PersonalisedFiles.hs @@ -60,6 +60,18 @@ data PersonalisedSheetFileUnresolved a makePrisms ''PersonalisedSheetFileUnresolved +data PersonalisedSheetFilesRestriction + = PSFRExamRegistered { psfrExam :: ExamId } + deriving (Eq, Ord, Read, Show, Generic, Typeable) + +makeLenses_ ''PersonalisedSheetFilesRestriction + +data PersonalisedSheetFilesForm = PersonalisedSheetFilesForm + { psffAnonymous :: PersonalisedSheetFilesDownloadAnonymous + , psffRestrictions :: Set PersonalisedSheetFilesRestriction + } deriving (Eq, Ord, Read, Show, Generic, Typeable) + + personalisedSheetFileTypes :: [SheetFileType] personalisedSheetFileTypes = filter (/= SheetMarking) universeF @@ -196,8 +208,9 @@ sourcePersonalisedSheetFiles :: forall m. -> Maybe SheetId -> Maybe (Set UserId) -> PersonalisedSheetFilesDownloadAnonymous + -> Set PersonalisedSheetFilesRestriction -> ConduitT () (Either PersonalisedSheetFile DBFile) (SqlPersistT m) () -sourcePersonalisedSheetFiles cId mbsid mbuids anonMode = do +sourcePersonalisedSheetFiles cId mbsid mbuids anonMode restrs = do (mbIdx, cIDKey) <- lift . newPersonalisedFilesKey $ maybe (Left cId) Right mbsid let genSuffixes uid = case anonMode of @@ -229,6 +242,10 @@ sourcePersonalisedSheetFiles cId mbsid mbuids anonMode = do case mbuids of Just uids -> E.where_ $ courseParticipant E.^. CourseParticipantUser `E.in_` E.valList (Set.toList uids) Nothing -> E.where_ $ courseParticipant E.^. CourseParticipantState E.==. E.val CourseParticipantActive + forM_ restrs $ \case + PSFRExamRegistered{..} -> E.where_ . E.exists . E.from $ \examRegistration -> + E.where_ $ examRegistration E.^. ExamRegistrationExam E.==. E.val psfrExam + E.&&. examRegistration E.^. ExamRegistrationUser E.==. courseParticipant E.^. CourseParticipantUser return (courseParticipant, personalisedSheetFile) toRefs = awaitForever $ \(Entity _ cPart@CourseParticipant{..}, mbPFile) -> do @@ -369,23 +386,26 @@ getPersonalFilesR cId mbsid = do <*> traverse get404 mbsid cRoute <- getCurrentRoute - ((anonRes, anonFormWdgt), anonEnctype) <- runFormGet . renderAForm FormStandard $ - apopt (selectField optionsFinite) (fslI MsgPersonalisedSheetFilesDownloadAnonymousField & setTooltip MsgPersonalisedSheetFilesDownloadAnonymousFieldTip) (Just PersonalisedSheetFilesDownloadAnonymous) + + let toRestrictions = maybe Set.empty $ Set.singleton . PSFRExamRegistered + ((psfRes, psfWdgt), psfEnctype) <- runFormGet . renderAForm FormStandard $ PersonalisedSheetFilesForm + <$> apopt (selectField optionsFinite) (fslI MsgPersonalisedSheetFilesDownloadAnonymousField & setTooltip MsgPersonalisedSheetFilesDownloadAnonymousFieldTip) (Just PersonalisedSheetFilesDownloadAnonymous) + <*> fmap toRestrictions (aopt (examField (Just $ SomeMessage MsgPersonalisedSheetFilesDownloadRestrictByExamNone) cId) (fslI MsgPersonalisedSheetFilesDownloadRestrictByExam & setTooltip MsgPersonalisedSheetFilesDownloadRestrictByExamTip) (Just $ mbSheet ^? _Just . _sheetType . _examPart . from _SqlKey)) - formResult anonRes $ \anonMode -> do + formResult psfRes $ \PersonalisedSheetFilesForm{..} -> do archiveName <- fmap (flip addExtension (unpack extensionZip) . unpack) . ap getMessageRender . pure $ case mbSheet of Nothing -> MsgCoursePersonalisedSheetFilesArchiveName courseTerm courseSchool courseShorthand Just Sheet{..} -> MsgPersonalisedSheetFilesArchiveName courseTerm courseSchool courseShorthand sheetName - sendResponse <=< serveZipArchive' archiveName $ sourcePersonalisedSheetFiles cId mbsid Nothing anonMode + sendResponse <=< serveZipArchive' archiveName $ sourcePersonalisedSheetFiles cId mbsid Nothing psffAnonymous psffRestrictions isModal <- hasCustomHeader HeaderIsModal fmap toTypedContent . siteLayoutMsg MsgMenuSheetPersonalisedFiles $ do setTitleI MsgMenuSheetPersonalisedFiles - wrapForm anonFormWdgt def + wrapForm psfWdgt def { formMethod = GET , formAction = SomeRoute <$> cRoute - , formEncoding = anonEnctype + , formEncoding = psfEnctype , formAttrs = formAttrs def <> bool mempty [("uw-no-navigate-away-prompt", ""), ("target", "_blank")] isModal }