diff --git a/CHANGELOG.md b/CHANGELOG.md index 5e9f80e91..fe60e202e 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,50 @@ All notable changes to this project will be documented in this file. See [standard-version](https://github.com/conventional-changelog/standard-version) for commit guidelines. +## [25.25.0](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/compare/v25.24.1...v25.25.0) (2022-01-21) + + +### Features + +* **communication:** support attachments in course/tutorial comm's ([5bd9ea8](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/5bd9ea85e8f0e4387cf47116bf42c4441bdbe8b3)) +* **file-field:** cumulative size limit ([b749039](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/b749039636c61157b5fc0bea9848ab9828ee671c)) + +## [25.24.1](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/compare/v25.24.0...v25.24.1) (2021-12-29) + + +### Bug Fixes + +* **courses:** enhanced description of study modules ([89fadb2](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/89fadb242037151ea792667cab85fc502b135f57)) + +## [25.24.0](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/compare/v25.23.0...v25.24.0) (2021-12-28) + + +### Features + +* **course:** show study module on course overview page ([dbc5e99](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/dbc5e99109285d4427832820a77a6b47a8098f62)) +* **course:** study modules as new course property ([cb00de7](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/cb00de7960c91d87f5f8fb7ecb29dd15cb61a5a3)) + +## [25.23.0](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/compare/v25.22.4...v25.23.0) (2021-12-14) + + +### Features + +* **check-all:** added shift click functionality ([da1c8b5](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/da1c8b54510ee1436fefe97ba32372a08299b83e)) +* **checkrange:** added tooltip ([ce6f09d](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/ce6f09dd857f53dc8c350d7d29b2164c78645b59)) +* **checkrange:** new util checkrange ([337bf73](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/337bf73067f2b98450d0388a1c064f0d2f9c456c)) +* **checkrange:** unchecking a range is possible ([154f2e3](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/154f2e35cc0e154ff80002b2e0aff3a76afa1ed6)) +* **erweiterung such-filter usersr:** first try ([da3b339](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/da3b3391bd5aa9990dfb2818847cf8524ee68a9d)) +* **messages:** added frontend translation class ([61c773f](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/61c773f51cddb65dd0529f17799cbf7871023137)) +* **tooltips:** added translatable tooltip ([e74b610](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/e74b61065a5de811bd411c0e863fddf9b9baada0)) + + +### Bug Fixes + +* **check-all:** correct constructor argument ([02ce82e](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/02ce82e9d2026730fd4716a2c0b070c38a6fc53f)) +* **frontend-tooltips:** icon is shown ([86ee2fb](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/86ee2fb14c05e3b6a78c6c51bf961b6c41d3e5c5)) +* **modal:** modals are never destroyed ([7dbe1ac](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/7dbe1ac08aacbda3b145a0da394706273dd6c639)) +* **modal:** modals are never destroyed ([53dab90](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/53dab90810675f743ece284883da9c4c0e84270e)) + ## [25.22.4](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/compare/v25.22.3...v25.22.4) (2021-10-26) diff --git a/config/settings.yml b/config/settings.yml index e7153913a..be47423b4 100644 --- a/config/settings.yml +++ b/config/settings.yml @@ -292,3 +292,5 @@ bot-mitigations: - only-logged-in-table-sorting volatile-cluster-settings-cache-time: 10 + +communication-attachments-max-size: 20971520 # 20MiB diff --git a/frontend/src/utils/check-all/check-all.js b/frontend/src/utils/check-all/check-all.js index 29e33cff8..83c3a5070 100644 --- a/frontend/src/utils/check-all/check-all.js +++ b/frontend/src/utils/check-all/check-all.js @@ -45,7 +45,7 @@ export class CheckAll { let checkboxColumns = this._findCheckboxColumns(); - checkboxColumns.forEach(columnId => this._checkAllColumns.push(new CheckAllColumn(this._element, app, this._columns[columnId]))); + checkboxColumns.forEach(columnId => this._checkAllColumns.push(new CheckAllColumn(this._element, app, this._columns[columnId], this._eventManager))); // mark initialized this._element.classList.add(CHECK_ALL_INITIALIZED_CLASS); diff --git a/frontend/src/utils/form/navigate-away-prompt.js b/frontend/src/utils/form/navigate-away-prompt.js index da900ba72..69c430853 100644 --- a/frontend/src/utils/form/navigate-away-prompt.js +++ b/frontend/src/utils/form/navigate-away-prompt.js @@ -107,7 +107,7 @@ export class NavigateAwayPrompt { // allow the event to happen if the form was not touched by the // user (i.e. if the current FormData is equal to the initial FormData) // or the unload event was initiated by a form submit - if (!formDataHasChanged || this.unloadDueToSubmit) + if (!formDataHasChanged || this.unloadDueToSubmit || this._parentModalIsClosed()) return; // cancel the unload event. This is the standard to force the prompt to appear. @@ -117,4 +117,13 @@ export class NavigateAwayPrompt { // for all non standard compliant browsers we return a truthy value to activate the prompt. return true; } + + _parentModalIsClosed() { + const parentModal = this._element.closest('.modal'); + if (!parentModal) + return false; + + const modalClosed = !parentModal.classList.contains('modal--open'); + return modalClosed; + } } diff --git a/frontend/src/utils/modal/modal.js b/frontend/src/utils/modal/modal.js index 8f013572f..6b8e28a17 100644 --- a/frontend/src/utils/modal/modal.js +++ b/frontend/src/utils/modal/modal.js @@ -72,16 +72,7 @@ export class Modal { } destroy() { - this._eventManager.cleanUp(); - if (this._closerElement !== undefined) - this._closerElement.remove(); - if(this._triggerElement !== undefined) - this._triggerElement.classList.remove(MODAL_TRIGGER_CLASS); - if(this._modalsWrapper !== undefined) - this._modalsWrapper.remove(); - if(this._modalOverlay !== undefined) - this._modalOverlay.remove(); - this._element.classList.remove(MODAL_INITIALIZED_CLASS, MODAL_CLASS); + throw new Error('Destroying modals is not possible.'); } _ensureModalWrapper() { @@ -164,7 +155,6 @@ export class Modal { this._modalsWrapper.classList.remove(MODALS_WRAPPER_OPEN_CLASS); document.removeEventListener('keyup', this._onKeyUp); - this._app.utilRegistry.destroyAll(this._element); }; _fillModal(url) { diff --git a/messages/uniworx/categories/courses/submission/de-de-formal.msg b/messages/uniworx/categories/courses/submission/de-de-formal.msg index 145768cc4..f2eedb946 100644 --- a/messages/uniworx/categories/courses/submission/de-de-formal.msg +++ b/messages/uniworx/categories/courses/submission/de-de-formal.msg @@ -186,6 +186,7 @@ UploadModeExtensionRestrictionTip: Komma-separiert. Wenn keine Dateiendungen ang UploadModeExtensionRestrictionMultipleTip: Einschränkung von Dateiendungen erfolgt für alle hochgeladenen Dateien, auch innerhalb von ZIP-Archiven. FileUploadMaxSize maxSize@Text: Datei darf maximal #{maxSize} groß sein FileUploadMaxSizeMultiple maxSize@Text: Dateien dürfen jeweils maximal #{maxSize} groß sein +FileUploadCumulativeMaxSize maxSize@Text: Dateien dürfen insgesamt maximal #{maxSize} groß sein InvalidPseudonym pseudonym@Text: Invalides Pseudonym "#{pseudonym}" InvalidPseudonymSubmissionIgnored oPseudonyms@Text iPseudonym@Text: Abgabe mit Pseudonymen „#{oPseudonyms}“ wurde ignoriert, da „#{iPseudonym}“ nicht automatisiert zu einem validen Pseudonym korrigiert werden konnte. diff --git a/messages/uniworx/categories/courses/submission/en-eu.msg b/messages/uniworx/categories/courses/submission/en-eu.msg index 0574c4a9d..2d0ffb872 100644 --- a/messages/uniworx/categories/courses/submission/en-eu.msg +++ b/messages/uniworx/categories/courses/submission/en-eu.msg @@ -186,6 +186,8 @@ UploadModeExtensionRestrictionTip: Comma-separated. If no file extensions are sp UploadModeExtensionRestrictionMultipleTip: Checks for valid file extension are performed for all uploaded files, including those packed within zip-archives. FileUploadMaxSize maxSize: File may be up to #{maxSize} in size FileUploadMaxSizeMultiple maxSize: Files may each be up to #{maxSize} in size +FileUploadCumulativeMaxSize maxSize: Files may be no larger than #{maxSize} in total + InvalidPseudonym pseudonym: Invalid pseudonym “#{pseudonym}” InvalidPseudonymSubmissionIgnored oPseudonyms iPseudonym: The submission with pseudonyms “#{oPseudonyms}” has been ignored since “#{iPseudonym}” could not be automatically corrected to be a valid pseudonym. PseudonymAutocorrections: Suggestions: diff --git a/messages/uniworx/utils/utils/de-de-formal.msg b/messages/uniworx/utils/utils/de-de-formal.msg index 06cc8c861..615126c14 100644 --- a/messages/uniworx/utils/utils/de-de-formal.msg +++ b/messages/uniworx/utils/utils/de-de-formal.msg @@ -17,6 +17,8 @@ RGTutorialParticipants tutn@TutorialName: Tutorium-Teilnehmer:innen (#{tutn}) RGExamRegistered examn@ExamName: Angemeldet zur Prüfung „#{examn}“ RGSheetSubmittor shn@SheetName: Abgebende für das Übungsblatt „#{shn}“ CommSubject: Betreff +CommAttachments: Anhänge +CommAttachmentsTip: Im Allgemeinen ist es vorzuziehen Dateien, die Sie mit den Empfängern teilen möchten, als Material hochzuladen (und ggf. in der Nachricht zu verlinken). So ist die Datei für die Empfänger dauerhaft abrufbar und auch Personen, die sich z.B. erst später zum Kurs anmelden, haben Zugriff auf die Datei. CommSuccess n@Int: Nachricht wurde an #{n} Empfänger versandt CommTestSuccess: Nachricht wurde zu Testzwecken nur an Sie selbst versandt @@ -53,6 +55,7 @@ UploadSpecificFileMaxSizeNegative: Maximale Dateigröße darf nicht negativ sein UploadSpecificFileEmptyOk: Leere Uploads erlauben UnknownPseudonymWord pseudonymWord@Text: Unbekanntes Pseudonym-Wort "#{pseudonymWord}" GenericFileFieldFileTooLarge file@FilePath: „#{file}“ ist zu groß +GenericFileFieldCumulativeTooLarge: Hochgeladene Dateien sind zu groß GenericFileFieldInvalidExtension file@FilePath: „#{file}” hat keine zulässige Dateiendung OnlyUploadOneFile: Bitte nur eine Datei hochladen. UploadAtLeastOneNonemptyFile: Bitte mindestens eine nichtleere Datei hochladen. diff --git a/messages/uniworx/utils/utils/en-eu.msg b/messages/uniworx/utils/utils/en-eu.msg index 41938f486..6f1ecad76 100644 --- a/messages/uniworx/utils/utils/en-eu.msg +++ b/messages/uniworx/utils/utils/en-eu.msg @@ -17,6 +17,8 @@ RGTutorialParticipants tutn: Tutorial participants (#{tutn}) RGExamRegistered examn: Registered for exam “#{examn}” RGSheetSubmittor shn: Submitted for exercise sheet “#{shn}” CommSubject: Subject +CommAttachments: Attachments +CommAttachmentsTip: In general it is preferable to upload files as course material instead of sending them as attachments. You can then link to the material from the message. The file is then permanently accessable to the recipients and to persons that, for example, register for the Course at a later date. CommSuccess n: Message was sent to #{n} #{pluralEN n "recipient" "recipients"} CommTestSuccess: Message was sent only to yourself for testing purposes @@ -53,6 +55,7 @@ UploadSpecificFileMaxSizeNegative: Maximum filesize may not be negative UploadSpecificFileEmptyOk: Allow empty uploads UnknownPseudonymWord pseudonymWord: Invalid pseudonym-word “#{pseudonymWord}” GenericFileFieldFileTooLarge file: “#{file}” is too large +GenericFileFieldCumulativeTooLarge: Uploaded files are too large GenericFileFieldInvalidExtension file: “#{file}” does not have an acceptable file extension OnlyUploadOneFile: Please only upload one file UploadAtLeastOneNonemptyFile: Please upload at least one nonempty file. diff --git a/package-lock.json b/package-lock.json index 3113011ef..cc145124e 100644 --- a/package-lock.json +++ b/package-lock.json @@ -1,6 +1,6 @@ { "name": "uni2work", - "version": "25.22.4", + "version": "25.25.0", "lockfileVersion": 1, "requires": true, "dependencies": { diff --git a/package.json b/package.json index ae47ea5a3..afc057afd 100644 --- a/package.json +++ b/package.json @@ -1,6 +1,6 @@ { "name": "uni2work", - "version": "25.22.4", + "version": "25.25.0", "description": "", "keywords": [], "author": "", diff --git a/package.yaml b/package.yaml index 43bc3cbc1..2648ecc7b 100644 --- a/package.yaml +++ b/package.yaml @@ -1,5 +1,5 @@ name: uniworx -version: 25.22.4 +version: 25.25.0 dependencies: - base - yesod diff --git a/src/Foundation/Yesod/StaticContent.hs b/src/Foundation/Yesod/StaticContent.hs index a60ace7ff..057c7b873 100644 --- a/src/Foundation/Yesod/StaticContent.hs +++ b/src/Foundation/Yesod/StaticContent.hs @@ -27,10 +27,10 @@ addStaticContent ext _mime content = do for ((,) <$> appWidgetMemcached <*> appWidgetMemcachedConf appSettings') $ \(mConn, WidgetMemcachedConf{ widgetMemcachedConf = MemcachedConf { memcachedExpiry }, widgetMemcachedBaseUrl }) -> do let expiry = maybe 0 ceiling memcachedExpiry touch = liftIO $ Memcached.touch expiry (encodeUtf8 $ pack fileName) mConn - add = liftIO $ Memcached.add zeroBits expiry (encodeUtf8 $ pack fileName) content mConn + addItem = liftIO $ Memcached.add zeroBits expiry (encodeUtf8 $ pack fileName) content mConn absoluteLink = unpack widgetMemcachedBaseUrl fileName catchIf Memcached.isKeyNotFound touch . const $ - handleIf Memcached.isKeyExists (const $ return ()) add + handleIf Memcached.isKeyExists (const $ return ()) addItem return . Left $ pack absoluteLink where -- Generate a unique filename based on the content itself, this is used diff --git a/src/Handler/Course/Edit.hs b/src/Handler/Course/Edit.hs index fb426ca94..6ef1789ea 100644 --- a/src/Handler/Course/Edit.hs +++ b/src/Handler/Course/Edit.hs @@ -29,29 +29,29 @@ import qualified Data.Conduit.List as C data CourseForm = CourseForm - { cfCourseId :: Maybe CourseId - , cfName :: CourseName - , cfShort :: CourseShorthand - , cfSchool :: SchoolId - , cfTerm :: TermId - , cfDesc :: Maybe StoredMarkup - , cfLink :: Maybe URI - , cfVisFrom :: Maybe UTCTime - , cfVisTo :: Maybe UTCTime - , cfMatFree :: Bool - , cfAllocation :: Maybe AllocationCourseForm + { cfCourseId :: Maybe CourseId + , cfName :: CourseName + , cfShort :: CourseShorthand + , cfSchool :: SchoolId + , cfTerm :: TermId + , cfDesc :: Maybe StoredMarkup + , cfLink :: Maybe URI + , cfVisFrom :: Maybe UTCTime + , cfVisTo :: Maybe UTCTime + , cfMatFree :: Bool + , cfAllocation :: Maybe AllocationCourseForm , cfAppRequired :: Bool , cfAppInstructions :: Maybe StoredMarkup , cfAppInstructionFiles :: Maybe FileUploads , cfAppText :: Bool , cfAppFiles :: UploadMode , cfAppRatingsVisible :: Bool - , cfCapacity :: Maybe Int - , cfSecret :: Maybe Text - , cfRegFrom :: Maybe UTCTime - , cfRegTo :: Maybe UTCTime - , cfDeRegUntil :: Maybe UTCTime - , cfLecturers :: [Either (UserEmail, Maybe LecturerType) (UserId, LecturerType)] + , cfCapacity :: Maybe Int + , cfSecret :: Maybe Text + , cfRegFrom :: Maybe UTCTime + , cfRegTo :: Maybe UTCTime + , cfDeRegUntil :: Maybe UTCTime + , cfLecturers :: [Either (UserEmail, Maybe LecturerType) (UserId, LecturerType)] } data AllocationCourseForm = AllocationCourseForm @@ -278,30 +278,28 @@ makeCourseForm miButtonAction template = identifyForm FIDcourse . validateFormDB hoist (censorM $ traverseOf _head addTip) $ optionalActionW' (bool mforcedJust mpopt mayChange) allocationForm' (fslI MsgCourseAllocationParticipate) (is _Just . cfAllocation <$> template) - -- let autoUnzipInfo = [|Entpackt hochgeladene Zip-Dateien (*.zip) automatisch und fügt den Inhalt dem Stamm-Verzeichnis der Abgabe hinzu. TODO|] - multipleSchoolsMsg <- messageI Warning MsgCourseSchoolMultipleTip multipleTermsMsg <- messageI Warning MsgCourseSemesterMultipleTip (result, widget) <- flip (renderAForm FormStandard) html $ CourseForm (cfCourseId =<< template) - <$> areq (textField & cfStrip & cfCI) (fslI MsgCourseName) (cfName <$> template) + <$> areq (textField & cfStrip & cfCI) (fslI MsgCourseName) (cfName <$> template) <*> areq (textField & cfStrip & cfCI) (fslpI MsgCourseShorthand "ProMo, LinAlg1, AlgoDat, Ana2, EiP, …" -- & addAttr "disabled" "disabled" - & setTooltip MsgCourseShorthandUnique) (cfShort <$> template) + & setTooltip MsgCourseShorthandUnique) (cfShort <$> template) <* bool (pure ()) (aformMessage multipleSchoolsMsg) (length userSchools > 1) - <*> areq (schoolFieldFor userSchools) (fslI MsgCourseSchool) (cfSchool <$> template) + <*> areq (schoolFieldFor userSchools) (fslI MsgCourseSchool) (cfSchool <$> template) <* bool (pure ()) (aformMessage multipleTermsMsg) (length userTerms > 1) - <*> areq termsField (fslI MsgCourseSemester) (cfTerm <$> template) + <*> areq termsField (fslI MsgCourseSemester) (cfTerm <$> template) <*> aopt htmlField (fslpI MsgCourseDescription (mr MsgCourseDescriptionPlaceholder)) - (cfDesc <$> template) + (cfDesc <$> template) <*> aopt urlField (fslpI MsgCourseHomepageExternal (mr MsgCourseHomepageExternalPlaceholder)) - (cfLink <$> template) + (cfLink <$> template) <*> aopt utcTimeField (fslpI MsgCourseVisibleFrom (mr MsgCourseDate) - & setTooltip MsgCourseVisibleFromTip) (deepAlt (cfVisFrom <$> template) newVisFrom) + & setTooltip MsgCourseVisibleFromTip) (deepAlt (cfVisFrom <$> template) newVisFrom) <*> aopt utcTimeField (fslpI MsgCourseVisibleTo (mr MsgCourseDate) - & setTooltip MsgCourseVisibleToTip) (cfVisTo <$> template) - <*> apopt checkBoxField (fslI MsgCourseMaterialFree) (cfMatFree <$> template) + & setTooltip MsgCourseVisibleToTip) (cfVisTo <$> template) + <*> apopt checkBoxField (fslI MsgCourseMaterialFree) (cfMatFree <$> template) <* aformSection MsgCourseFormSectionRegistration <*> allocationForm <*> apopt checkBoxField (fslI MsgCourseApplicationRequired & setTooltip MsgCourseApplicationRequiredTip) (cfAppRequired <$> template) diff --git a/src/Handler/Users.hs b/src/Handler/Users.hs index 29963c64e..fd9d5823d 100644 --- a/src/Handler/Users.hs +++ b/src/Handler/Users.hs @@ -167,6 +167,15 @@ postUsersR = do -- Set.foldr (\needle acc -> acc E.||. (user E.^. UserDisplayName) `E.hasInfix` needle) eFalse (criterion :: Set.Set Text) E.any (\c -> user E.^. UserDisplayName `E.hasInfix` E.val c) criteria ) + , ( "user-ident", FilterColumn $ \user criterion -> case getLast (criterion :: Last Text) of + Nothing -> E.val True :: E.SqlExpr (E.Value Bool) + Just needle -> E.castString (user E.^. UserIdent) `E.ilike` (E.%) E.++. E.val needle E.++. (E.%) + ) + , ( "user-email", FilterColumn $ \user criterion -> case getLast (criterion :: Last Text) of + Nothing -> E.val True :: E.SqlExpr (E.Value Bool) + Just needle -> (E.castString (user E.^. UserEmail) `E.ilike` (E.%) E.++. E.val needle E.++. (E.%)) + E.||. (E.castString (user E.^. UserDisplayEmail) `E.ilike` (E.%) E.++. E.val needle E.++. (E.%)) +) , ( "matriculation", FilterColumn $ \user (criteria :: Set.Set Text) -> if | Set.null criteria -> E.true -- TODO: why can this be eFalse and work still? | otherwise -> E.any (\c -> user E.^. UserMatrikelnummer `E.hasInfix` E.val c) criteria @@ -192,6 +201,8 @@ postUsersR = do ] , dbtFilterUI = \mPrev -> mconcat [ prismAForm (singletonFilter "user-search") mPrev $ aopt textField (fslI MsgName) + , prismAForm (singletonFilter "user-ident") mPrev $ aopt textField (fslI MsgAdminUserIdent) + , prismAForm (singletonFilter "user-email") mPrev $ aopt textField (fslI MsgAdminUserEmail) -- , prismAForm (singletonFilter "matriculation" ) mPrev $ aopt textField (fslI MsgTableMatrikelNr) , prismAForm (singletonFilter "matriculation") mPrev $ aopt matriculationField (fslI MsgTableMatrikelNr) , prismAForm (singletonFilter "auth-ldap" . maybePrism _PathPiece) mPrev $ aopt (lift `hoistField` selectFieldList [(MsgAuthPWHash "", False), (MsgAuthLDAP, True)]) (fslI MsgAuthMode) diff --git a/src/Handler/Utils/Communication.hs b/src/Handler/Utils/Communication.hs index ca32a1b71..39e1681ce 100644 --- a/src/Handler/Utils/Communication.hs +++ b/src/Handler/Utils/Communication.hs @@ -78,16 +78,16 @@ data CommunicationRoute = CommunicationRoute data Communication = Communication { cRecipients :: Set (Either UserEmail UserId) - , cSubject :: Maybe Text - , cBody :: Html + , cContent :: CommunicationContent } +makeLenses_ ''Communication + crJobsCourseCommunication, crTestJobsCourseCommunication :: CourseId -> Communication -> ConduitT () Job (YesodDB UniWorX) () crJobsCourseCommunication jCourse Communication{..} = do jSender <- requireAuthId - let jSubject = cSubject - jMailContent = cBody + let jMailContent = cContent allRecipients = Set.toList $ Set.insert (Right jSender) cRecipients jMailObjectUUID <- liftIO getRandom jAllRecipientAddresses <- lift . fmap Set.fromList . forM allRecipients $ \case @@ -99,7 +99,7 @@ crTestJobsCourseCommunication jCourse comm = do jSender <- requireAuthId MsgRenderer mr <- getMsgRenderer - let comm' = comm { cSubject = Just . mr . MsgCommCourseTestSubject . fromMaybe (mr MsgUtilCommCourseSubject) $ cSubject comm } + let comm' = comm & _cContent . _ccSubject %~ Just . mr . MsgCommCourseTestSubject . fromMaybe (mr MsgUtilCommCourseSubject) crJobsCourseCommunication jCourse comm' .| C.filter ((== Right jSender) . jRecipientEmail) @@ -206,11 +206,24 @@ commR CommunicationRoute{..} = do recipientsListMsg <- messageI Info MsgCommRecipientsList + attachmentsMaxSize <- getsYesod $ view _appCommunicationAttachmentsMaxSize + let attachmentField = genericFileField $ return FileField + { fieldIdent = Nothing + , fieldUnpackZips = FileFieldUserOption True False + , fieldMultiple = True + , fieldRestrictExtensions = Nothing + , fieldAdditionalFiles = _FileReferenceFileReferenceTitleMap # Map.empty + , fieldMaxFileSize = Nothing, fieldMaxCumulativeSize = attachmentsMaxSize + , fieldAllEmptyOk = True + } ((commRes,commWdgt),commEncoding) <- runFormPost . identifyForm FIDCommunication . withButtonForm' universeF . renderAForm FormStandard $ Communication <$> recipientAForm <* aformMessage recipientsListMsg - <*> aopt textField (fslI MsgCommSubject & addAttr "uw-enter-as-tab" "") Nothing - <*> (markupOutput <$> areq htmlField (fslI MsgCommBody) Nothing) + <*> ( CommunicationContent + <$> aopt textField (fslI MsgCommSubject & addAttr "uw-enter-as-tab" "") Nothing + <*> (markupOutput <$> areq htmlField (fslI MsgCommBody) Nothing) + <*> fmap fold (aopt (convertFieldM (runConduit . (.| C.foldMap Set.singleton)) yieldMany attachmentField) (fslI MsgCommAttachments & setTooltip MsgCommAttachmentsTip) Nothing) + ) formResult commRes $ \case (comm, BtnCommunicationSend) -> do runDBJobs . runConduit $ transPipe (mapReaderT lift) (crJobs comm) .| sinkDBJobs diff --git a/src/Handler/Utils/Files.hs b/src/Handler/Utils/Files.hs index 83b5f7552..98b1e602e 100644 --- a/src/Handler/Utils/Files.hs +++ b/src/Handler/Utils/Files.hs @@ -1,3 +1,5 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} + module Handler.Utils.Files ( sourceFile, sourceFile' , sourceFiles, sourceFiles' @@ -9,6 +11,7 @@ module Handler.Utils.Files import Import.NoFoundation hiding (First(..)) import Foundation.Type +import Foundation.DB import Utils.Metrics import Data.Monoid (First(..)) @@ -181,6 +184,11 @@ sourceFiles' = C.map sourceFile' sourceFile' :: forall file. (HasFileReference file, YesodPersistBackend UniWorX ~ SqlBackend) => file -> DBFile sourceFile' = sourceFile . view (_FileReference . _1) + +instance (YesodMail UniWorX, YesodPersistBackend UniWorX ~ SqlBackend) => ToMailPart UniWorX FileReference where + toMailPart = toMailPart <=< liftHandler . runDBRead . withReaderT projectBackend . toPureFile . sourceFile' + + respondFileConditional :: (MonadThrow m, MonadHandler m, HandlerSite m ~ UniWorX, YesodPersistBackend UniWorX ~ SqlBackend, YesodPersistRunner UniWorX) => Maybe UTCTime -> MimeType -> FileReference diff --git a/src/Handler/Utils/Form.hs b/src/Handler/Utils/Form.hs index 34a372192..92940d471 100644 --- a/src/Handler/Utils/Form.hs +++ b/src/Handler/Utils/Form.hs @@ -998,15 +998,20 @@ genericFileField mkOpts = Field{..} = not (permittedExtension opts fName) && (not doUnpack || ((/=) `on` simpleContentType) (mimeLookup fName) typeZip) - whenIsJust fieldMaxFileSize $ \maxSize -> forM_ files $ \fInfo -> do - fLength <- runConduit $ fileSource fInfo .| C.takeE (fromIntegral $ succ maxSize) .| C.lengthE - when (fLength > maxSize) $ do - when (is _Just mIdent) $ - liftHandler . runDB . runConduit $ - mapM_ (transPipe lift . handleFile) files - .| handleUpload opts mIdent - .| C.sinkNull - throwE . SomeMessage . MsgGenericFileFieldFileTooLarge . unpack $ fileName fInfo + whenIsJust (ignoreNothing min fieldMaxFileSize fieldMaxCumulativeSize) $ \takeSize -> + flip evalAccumT mempty . forM_ files $ \fInfo -> do + fLength <- lift . runConduit $ fileSource fInfo .| C.takeE (fromIntegral $ succ takeSize) .| C.lengthE + add $ Sum fLength + Sum cummSize <- look + when (NTop (Just cummSize) > NTop fieldMaxCumulativeSize || NTop (Just fLength) > NTop fieldMaxFileSize) $ do + when (is _Just mIdent) $ + lift . liftHandler . runDB . runConduit $ + mapM_ (transPipe lift . handleFile) files + .| handleUpload opts mIdent + .| C.sinkNull + when (NTop (Just fLength) > NTop fieldMaxFileSize) $ do + lift . throwE . SomeMessage . MsgGenericFileFieldFileTooLarge . unpack $ fileName fInfo + lift . throwE $ SomeMessage MsgGenericFileFieldCumulativeTooLarge if | invExt : _ <- filter invalidUploadExtension uploadedFilenames -> do @@ -1125,7 +1130,7 @@ fileFieldMultiple = genericFileField $ return FileField , fieldMultiple = True , fieldRestrictExtensions = Nothing , fieldAdditionalFiles = _FileReferenceFileReferenceTitleMap # Map.empty - , fieldMaxFileSize = Nothing + , fieldMaxFileSize = Nothing, fieldMaxCumulativeSize = Nothing , fieldAllEmptyOk = True } @@ -1145,7 +1150,7 @@ singleFileField prev = genericFileField $ do [ (fileReferenceTitle, (fileReferenceContent, fileReferenceModified, FileFieldUserOption False True)) | FileReference{..} <- Set.toList permitted ] - , fieldMaxFileSize = Nothing + , fieldMaxFileSize = Nothing, fieldMaxCumulativeSize = Nothing , fieldAllEmptyOk = True } @@ -1161,7 +1166,7 @@ specificFileField UploadSpecificFile{..} mPrev = convertField (.| fixupFileTitle [ (fileReferenceTitle, (fileReferenceContent, fileReferenceModified, FileFieldUserOption False True)) | FileReference{..} <- Set.toList previous ] - , fieldMaxFileSize = specificFileMaxSize + , fieldMaxFileSize = specificFileMaxSize, fieldMaxCumulativeSize = Nothing , fieldAllEmptyOk = specificFileEmptyOk } where @@ -1189,7 +1194,7 @@ zipFileField' doUnpack permittedExtensions emptyOk mPrev = genericFileField $ do [ (fileReferenceTitle, (fileReferenceContent, fileReferenceModified, FileFieldUserOption False True)) | FileReference{..} <- Set.toList previous ] - , fieldMaxFileSize = Nothing + , fieldMaxFileSize = Nothing, fieldMaxCumulativeSize = Nothing , fieldAllEmptyOk = emptyOk } @@ -1232,7 +1237,7 @@ multiFileField mkPermitted = genericFileField $ mkField <$> mkPermitted [ (fileReferenceTitle, (fileReferenceContent, fileReferenceModified, FileFieldUserOption False True)) | FileReference{..} <- Set.toList permitted ] - , fieldMaxFileSize = Nothing + , fieldMaxFileSize = Nothing, fieldMaxCumulativeSize = Nothing , fieldAllEmptyOk = True } diff --git a/src/Handler/Utils/Workflow/Form.hs b/src/Handler/Utils/Workflow/Form.hs index 8dfc47982..0ac389ebc 100644 --- a/src/Handler/Utils/Workflow/Form.hs +++ b/src/Handler/Utils/Workflow/Form.hs @@ -70,6 +70,7 @@ instance ToJSON (FileField FileIdent) where , pure $ "multiple" JSON..= fieldMultiple , pure $ "restrict-extensions" JSON..= fieldRestrictExtensions , pure $ "max-file-size" JSON..= fieldMaxFileSize + , pure $ "max-cumulative-size" JSON..= fieldMaxCumulativeSize , pure $ "additional-files" JSON..= addFiles' ] where addFiles' = unFileIdentFileReferenceTitleMap fieldAdditionalFiles <&> \FileIdentFileReferenceTitleMapElem{..} -> JSON.object @@ -83,6 +84,7 @@ instance FromJSON (FileField FileIdent) where fieldMultiple <- o JSON..: "multiple" fieldRestrictExtensions <- o JSON..:? "restrict-extensions" fieldMaxFileSize <- o JSON..:? "max-file-size" + fieldMaxCumulativeSize <- o JSON..:? "max-cumulative-size" fieldAllEmptyOk <- o JSON..:? "all-empty-ok" JSON..!= True addFiles' <- o JSON..:? "additional-files" JSON..!= mempty fieldAdditionalFiles <- fmap FileIdentFileReferenceTitleMap . for addFiles' $ JSON.withObject "FileIdentFileReferenceTitleMapElem" $ \o' -> do diff --git a/src/Import/NoModel.hs b/src/Import/NoModel.hs index ad0ac8f97..4a75b8fe6 100644 --- a/src/Import/NoModel.hs +++ b/src/Import/NoModel.hs @@ -118,6 +118,11 @@ import Control.Monad.Trans.State as Import ( State, runState, mapState, withState , StateT(..), mapStateT, withStateT ) +import Control.Monad.Trans.Accum as Import + ( Accum, runAccum, mapAccum + , AccumT, runAccumT, execAccumT, evalAccumT, mapAccumT + , look, looks, add + ) import Control.Monad.State.Class as Import (MonadState(state)) import Control.Monad.Trans.Writer.Lazy as Import ( Writer, runWriter, mapWriter, execWriter diff --git a/src/Jobs/Handler/Files.hs b/src/Jobs/Handler/Files.hs index 7ab592eb1..de6787c0d 100644 --- a/src/Jobs/Handler/Files.hs +++ b/src/Jobs/Handler/Files.hs @@ -47,6 +47,9 @@ import qualified Data.Foldable as F import qualified Control.Monad.State.Class as State +import Jobs.Types +import Data.Aeson.Lens (_JSON) + dispatchJobPruneSessionFiles :: JobHandler UniWorX dispatchJobPruneSessionFiles = JobHandlerAtomicWithFinalizer act fin @@ -83,6 +86,9 @@ workflowFileReferences = Map.fromList $ over (traverse . _1) nameToPathPiece , (''WorkflowWorkflow, E.selectSource (E.from $ pure . (E.^. WorkflowWorkflowState )) .| awaitForever (mapMOf_ (typesCustom @WorkflowChildren . _fileReferenceContent . _Just) yield . E.unValue)) ] +jobFileReferences :: MonadResource m => ConduitT () FileContentReference (SqlPersistT m) () +jobFileReferences = E.selectSource (E.from $ pure . (E.^. QueuedJobContent)) .| C.mapMaybe (preview _JSON . E.unValue) .| awaitForever (mapMOf_ (typesCustom @JobChildren @Job @Job @FileContentReference @FileContentReference) yield) + dispatchJobDetectMissingFiles :: JobHandler UniWorX dispatchJobDetectMissingFiles = JobHandlerAtomicDeferrableWithFinalizer act fin @@ -103,8 +109,10 @@ dispatchJobDetectMissingFiles = JobHandlerAtomicDeferrableWithFinalizer act fin E.distinctOnOrderBy [E.asc ref] $ return ref transPipe lift (E.selectSource fileReferencesQuery) .| C.mapMaybe E.unValue .| C.mapM_ (insertRef refKind) - iforM_ workflowFileReferences $ \refKind refSource -> - transPipe (lift . withReaderT projectBackend) (refSource .| C.filterM (\ref -> not <$> exists [FileContentEntryHash ==. ref])) .| C.mapM_ (insertRef refKind) + let useRefSource refKind refSource = transPipe (lift . withReaderT projectBackend) (refSource .| C.filterM (\ref -> not <$> exists [FileContentEntryHash ==. ref])) .| C.mapM_ (insertRef refKind) + iforM_ workflowFileReferences useRefSource + useRefSource (nameToPathPiece ''Job) jobFileReferences + let allMissingDb :: Set Minio.Object allMissingDb = setOf (folded . folded . re minioFileReference) missingDb @@ -204,14 +212,16 @@ dispatchJobPruneUnreferencedFiles numIterations epoch iteration = JobHandlerAtom return $ E.any E.exists (fileReferences $ fileContentEntry E.^. FileContentEntryHash) E.where_ $ chunkIdFilter unreferencedChunkHash - let unmarkWorkflowFiles (otoList -> fRefs) = E.delete . E.from $ \fileContentChunkUnreferenced -> do + let unmarkSourceFiles (otoList -> fRefs) = E.delete . E.from $ \fileContentChunkUnreferenced -> do let unreferencedChunkHash = E.unKey $ fileContentChunkUnreferenced E.^. FileContentChunkUnreferencedHash E.where_ . E.subSelectOr . E.from $ \fileContentEntry -> do E.where_ $ fileContentEntry E.^. FileContentEntryChunkHash E.==. unreferencedChunkHash return $ fileContentEntry E.^. FileContentEntryHash `E.in_` E.valList fRefs E.where_ $ chunkIdFilter unreferencedChunkHash + unmarkRefSource refSource = runConduit $ refSource .| C.map Seq.singleton .| C.chunksOfE chunkSize .| C.mapM_ unmarkSourceFiles chunkSize = 100 - in runConduit $ sequence_ workflowFileReferences .| C.map Seq.singleton .| C.chunksOfE chunkSize .| C.mapM_ unmarkWorkflowFiles + unmarkRefSource $ sequence_ workflowFileReferences + unmarkRefSource jobFileReferences let getEntryCandidates = E.selectSource . E.from $ \fileContentEntry -> do diff --git a/src/Jobs/Handler/SendCourseCommunication.hs b/src/Jobs/Handler/SendCourseCommunication.hs index 712fd4beb..7a3433645 100644 --- a/src/Jobs/Handler/SendCourseCommunication.hs +++ b/src/Jobs/Handler/SendCourseCommunication.hs @@ -20,10 +20,9 @@ dispatchJobSendCourseCommunication :: Either UserEmail UserId -> CourseId -> UserId -> UUID - -> Maybe Text - -> Html + -> CommunicationContent -> JobHandler UniWorX -dispatchJobSendCourseCommunication jRecipientEmail jAllRecipientAddresses jCourse jSender jMailObjectUUID jSubject jMailContent = JobHandlerException $ do +dispatchJobSendCourseCommunication jRecipientEmail jAllRecipientAddresses jCourse jSender jMailObjectUUID CommunicationContent{..} = JobHandlerException $ do (sender, Course{..}) <- runDB $ (,) <$> getJust jSender <*> getJust jCourse @@ -34,8 +33,9 @@ dispatchJobSendCourseCommunication jRecipientEmail jAllRecipientAddresses jCours _mailFrom .= userAddressFrom sender addMailHeader "Cc" [st|#{mr MsgCommUndisclosedRecipients}:;|] addMailHeader "Auto-Submitted" "no" - setSubjectI . prependCourseTitle courseTerm courseSchool courseShorthand $ maybe (SomeMessage MsgCommCourseSubject) SomeMessage jSubject + setSubjectI . prependCourseTitle courseTerm courseSchool courseShorthand $ maybe (SomeMessage MsgCommCourseSubject) SomeMessage ccSubject addHtmlMarkdownAlternatives ($(ihamletFile "templates/mail/courseCommunication.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX)) + forM_ ccAttachments $ addPart' . toMailPart when (jRecipientEmail == Right jSender) $ addPart' $ do partIsAttachmentCsv MsgCommAllRecipients diff --git a/src/Jobs/Types.hs b/src/Jobs/Types.hs index 94afb6b53..9efc5df8c 100644 --- a/src/Jobs/Types.hs +++ b/src/Jobs/Types.hs @@ -44,7 +44,7 @@ import Cron (CronNextMatch(..), _MatchAsap, _MatchAt, _MatchNone) import System.Clock (getTime, Clock(Monotonic), TimeSpec) import GHC.Conc (unsafeIOToSTM) -import Data.Generics.Product.Types (Children, ChGeneric) +import Data.Generics.Product.Types (Children, ChGeneric, HasTypesCustom(..)) {-# ANN module ("HLint: ignore Use newtype instead of data" :: String) #-} @@ -67,8 +67,7 @@ data Job , jCourse :: CourseId , jSender :: UserId , jMailObjectUUID :: UUID - , jSubject :: Maybe Text - , jMailContent :: Html + , jMailContent :: CommunicationContent } | JobInvitation { jInviter :: Maybe UserId , jInvitee :: UserEmail @@ -169,10 +168,14 @@ type family ChildrenJobChildren a where ChildrenJobChildren UUID = '[] ChildrenJobChildren (Key a) = '[] ChildrenJobChildren (CI a) = '[] - ChildrenJobChildren (Set a) = '[] + ChildrenJobChildren (Set v) = '[v] ChildrenJobChildren MailContext = '[] + ChildrenJobChildren (Digest a) = '[] ChildrenJobChildren a = Children ChGeneric a + +instance (Ord b', HasTypesCustom JobChildren a' b' a b) => HasTypesCustom JobChildren (Set a') (Set b') a b where + typesCustom = iso Set.toList Set.fromList . traverse . typesCustom @JobChildren classifyJob :: Job -> String diff --git a/src/Mail.hs b/src/Mail.hs index 827467b8e..4a3d560fb 100644 --- a/src/Mail.hs +++ b/src/Mail.hs @@ -42,6 +42,7 @@ import Data.Kind (Type) import Model.Types.Languages import Model.Types.Csv +import Model.Types.File import Network.Mail.Mime hiding (addPart, addAttachment) import qualified Network.Mail.Mime as Mime (addPart) @@ -89,7 +90,7 @@ import qualified Data.Binary as Binary import "network-bsd" Network.BSD (getHostName) import Data.Time.Zones (utcTZ, utcToLocalTimeTZ, timeZoneForUTCTime) -import Data.Time.LocalTime (ZonedTime(..), TimeZone(..)) +import Data.Time.LocalTime (ZonedTime(..), TimeZone(..), utcToZonedTime, utc) import Data.Time.Format (rfc822DateFormat) import Network.HaskellNet.SMTP (SMTPConnection) @@ -123,6 +124,12 @@ import Language.Haskell.TH (nameBase) import Network.Mail.Mime.Instances() +import Data.Char (isLatin1) +import Data.Text.Lazy.Encoding (decodeUtf8') +import System.FilePath (takeFileName) +import Network.HTTP.Types.Header (hETag) +import Web.HttpApiData (ToHttpApiData(toHeader)) + makeLenses_ ''Address makeLenses_ ''Mail @@ -346,6 +353,20 @@ instance YesodMail site => ToMailPart site Html where _partEncoding .= QuotedPrintableText _partContent .= PartContent (renderMarkup html) +instance YesodMail site => ToMailPart site PureFile where + toMailPart file@File{fileTitle, fileModified} = do + _partDisposition .= AttachmentDisposition (pack $ takeFileName fileTitle) + _partType .= decodeUtf8 (mimeLookup $ pack fileTitle) + let + content :: LBS.ByteString + content = file ^. _pureFileContent . _Just + isLatin = either (const False) (all isLatin1) $ decodeUtf8' content + _partEncoding .= bool Base64 QuotedPrintableText isLatin + _partContent .= PartContent content + forM_ (file ^. _FileReference . _1 . _fileReferenceContent) $ \fRefContent -> + replaceMailHeader (CI.original hETag) . Just . decodeUtf8 . toHeader $ etagFileReference # fRefContent + replaceMailHeader (CI.original hLastModified) . Just . pack . formatTime defaultTimeLocale rfc822DateFormat $ utcToZonedTime utc fileModified + instance (ToMailPart site a, RenderMessage site msg) => ToMailPart site (Hamlet.Translate msg -> a) where type MailPartReturn site (Hamlet.Translate msg -> a) = MailPartReturn site a toMailPart act = do diff --git a/src/Model/Types.hs b/src/Model/Types.hs index 4966c28b5..0de01da40 100644 --- a/src/Model/Types.hs +++ b/src/Model/Types.hs @@ -24,3 +24,4 @@ import Model.Types.Markup as Types import Model.Types.Room as Types import Model.Types.Csv as Types import Model.Types.Upload as Types +import Model.Types.Communication as Types diff --git a/src/Model/Types/Communication.hs b/src/Model/Types/Communication.hs new file mode 100644 index 000000000..b21f3e101 --- /dev/null +++ b/src/Model/Types/Communication.hs @@ -0,0 +1,21 @@ +module Model.Types.Communication + ( CommunicationContent(..), _ccSubject, _ccBody, _ccAttachments + ) where + +import Import.NoModel +import Model.Types.File + +import Utils.Lens.TH + + +data CommunicationContent = CommunicationContent + { ccSubject :: Maybe Text + , ccBody :: Html + , ccAttachments :: Set FileReference + } deriving stock (Eq, Ord, Show, Read, Generic, Typeable) + deriving anyclass (Hashable, NFData) + +deriveJSON defaultOptions + { constructorTagModifier = camelToPathPiece' 1 + } ''CommunicationContent +makeLenses_ ''CommunicationContent diff --git a/src/Model/Types/File.hs b/src/Model/Types/File.hs index 0a3819c28..2d26ae6ce 100644 --- a/src/Model/Types/File.hs +++ b/src/Model/Types/File.hs @@ -18,7 +18,24 @@ module Model.Types.File , _fieldIdent, _fieldUnpackZips, _fieldMultiple, _fieldRestrictExtensions, _fieldAdditionalFiles, _fieldMaxFileSize ) where -import Import.NoModel +import ClassyPrelude.Yesod hiding (snoc, (.=), getMessageRender, derivePersistFieldJSON, Proxy(..)) +import Crypto.Hash (Digest, SHA3_512) +import Language.Haskell.TH.Syntax (Lift) +import Data.Binary (Binary) +import Crypto.Hash.Instances () +import Data.Proxy (Proxy(..)) +import Control.Lens +import Utils.HttpConditional +import Data.Binary.Instances.Time () +import Data.Time.Clock.Instances () +import Data.Aeson.TH +import Utils +import Data.Kind (Type) +import Data.Universe +import Numeric.Natural +import Network.Mime +import Control.Monad.Morph +import Data.NonNull.Instances () import Database.Persist.Sql (PersistFieldSql(..)) import Web.HttpApiData (ToHttpApiData, FromHttpApiData) @@ -204,7 +221,6 @@ instance HasFileReference FileReference where instance HasFileReference PureFile where newtype FileReferenceResidual PureFile = PureFileResidual { unPureFileResidual :: Maybe ByteString } deriving (Eq, Ord, Read, Show, Generic, Typeable) - deriving newtype (ToJSON, FromJSON) deriving anyclass (NFData) _FileReference = iso toFileReference fromFileReference @@ -293,7 +309,7 @@ data FileField fileid = FileField , fieldUnpackZips :: FileFieldUserOption Bool , fieldMultiple :: Bool , fieldRestrictExtensions :: Maybe (NonNull (Set Extension)) - , fieldMaxFileSize :: Maybe Natural + , fieldMaxFileSize, fieldMaxCumulativeSize :: Maybe Natural , fieldAdditionalFiles :: FileReferenceTitleMap fileid (FileFieldUserOption Bool) , fieldAllEmptyOk :: Bool } @@ -311,6 +327,7 @@ instance ToJSON (FileField FileReference) where , pure $ "multiple" JSON..= fieldMultiple , pure $ "restrict-extensions" JSON..= fieldRestrictExtensions , pure $ "max-file-size" JSON..= fieldMaxFileSize + , pure $ "max-cumulative-size" JSON..= fieldMaxCumulativeSize , pure $ "additional-files" JSON..= addFiles' , pure $ "all-empty-ok" JSON..= fieldAllEmptyOk ] @@ -326,6 +343,7 @@ instance FromJSON (FileField FileReference) where fieldMultiple <- o JSON..: "multiple" fieldRestrictExtensions <- o JSON..:? "restrict-extensions" fieldMaxFileSize <- o JSON..:? "max-file-size" + fieldMaxCumulativeSize <- o JSON..:? "max-cumulative-size" fieldAllEmptyOk <- o JSON..:? "all-empty-ok" JSON..!= True addFiles' <- o JSON..:? "additional-files" JSON..!= mempty fieldAdditionalFiles <- fmap FileReferenceFileReferenceTitleMap . for addFiles' $ JSON.withObject "FileReferenceFileReferenceTitleMapElem" $ \o' -> do diff --git a/src/Settings.hs b/src/Settings.hs index 3e904da07..b056dfc1f 100644 --- a/src/Settings.hs +++ b/src/Settings.hs @@ -226,6 +226,8 @@ data AppSettings = AppSettings , appVolatileClusterSettingsCacheTime :: DiffTime , appJobMaxFlush :: Maybe Natural + + , appCommunicationAttachmentsMaxSize :: Maybe Natural } deriving Show data JobMode = JobsLocal { jobsAcceptOffload :: Bool } @@ -695,6 +697,8 @@ instance FromJSON AppSettings where appJobMaxFlush <- o .:? "job-max-flush" + appCommunicationAttachmentsMaxSize <- o .:? "communication-attachments-max-size" + return AppSettings{..} where isValidARCConf ARCConf{..} = arccMaximumWeight > 0 diff --git a/templates/i18n/changelog/communication-attachments.de-de-formal.hamlet b/templates/i18n/changelog/communication-attachments.de-de-formal.hamlet new file mode 100644 index 000000000..83b10409b --- /dev/null +++ b/templates/i18n/changelog/communication-attachments.de-de-formal.hamlet @@ -0,0 +1,2 @@ +$newline never +An Kurs- und Tutoriumsmitteilungen können nun Dateien angehängt werden. diff --git a/templates/i18n/changelog/communication-attachments.en-eu.hamlet b/templates/i18n/changelog/communication-attachments.en-eu.hamlet new file mode 100644 index 000000000..378ed8ad5 --- /dev/null +++ b/templates/i18n/changelog/communication-attachments.en-eu.hamlet @@ -0,0 +1,2 @@ +$newline never +Course- and tutorial messages (emails) may now carry attached files. diff --git a/templates/mail/courseCommunication.hamlet b/templates/mail/courseCommunication.hamlet index b63e2827e..b6e305827 100644 --- a/templates/mail/courseCommunication.hamlet +++ b/templates/mail/courseCommunication.hamlet @@ -4,4 +4,4 @@ $newline never - #{jMailContent} + #{ccBody} diff --git a/templates/widgets/genericFileField.hamlet b/templates/widgets/genericFileField.hamlet index d1f6d622f..04a5581ac 100644 --- a/templates/widgets/genericFileField.hamlet +++ b/templates/widgets/genericFileField.hamlet @@ -33,7 +33,7 @@ $if not (null fileInfos)
_{MsgUtilAddMoreFiles} $# new files - + $if fieldMultiple
@@ -57,6 +57,10 @@ $maybe maxSize <- fieldMaxFileSize $else _{MsgFileUploadMaxSize (textBytes maxSize)} +$maybe maxSize <- fieldMaxCumulativeSize +
+ _{MsgFileUploadCumulativeMaxSize (textBytes maxSize)} + $if not (fieldOptionForce fieldUnpackZips)
^{iconTooltip (i18n MsgAutoUnzipInfo) Nothing False}