diff --git a/ChangeLog.md b/ChangeLog.md index 9f07bd783..64cf0b8f7 100644 --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,3 +1,7 @@ + * Version 20.05.2019 + + Komplett überarbeitete Funktionalität zur automatischen Verteilung von Korrekturen + * Version 13.05.2019 Kursverwalter können Teilnehmer hinzufügen diff --git a/config/archive-types b/config/archive-types new file mode 100644 index 000000000..0599971bb --- /dev/null +++ b/config/archive-types @@ -0,0 +1,40 @@ +# Simple list of mime-types corresponding to archive-formats +# +# Comments are empty lines and any line for which the first non-whitespace symbol is ‘#’ +# +# Format is a single mime-type per line (may not contain whitespace) +# +# Largely copied from https://en.wikipedia.org/wiki/List_of_archive_formats + +application/x-archive +application/x-cpio +application/x-bcpio +application/x-shar +application/x-iso9660-image +application/x-sbx +application/x-tar +application/x-7z-compressed +application/x-ace-compressed +application/x-astrotite-afa +application/x-alz-compressed +application/vnd.android.package-archive +application/x-arj +application/x-b1 +application/vnd.ms-cab-compressed +application/x-cfs-compressed +application/x-dar +application/x-dgc-compressed +application/x-apple-diskimage +application/x-gca-compressed +application/java-archive +application/x-lzh +application/x-lzx +application/x-rar-compressed +application/x-stuffit +application/x-stuffitx +application/x-gtar +application/x-ms-wim +application/x-xar +application/zip +application/x-zoo +application/x-par2 \ No newline at end of file diff --git a/config/settings.yml b/config/settings.yml index 049692e5b..edd971e64 100644 --- a/config/settings.yml +++ b/config/settings.yml @@ -30,9 +30,14 @@ session-timeout: 7200 jwt-expiration: 604800 jwt-encoding: HS256 maximum-content-length: "_env:MAX_UPLOAD_SIZE:134217728" -health-check-interval: "_env:HEALTHCHECK_INTERVAL:600" # or WATCHDOG_USEC/2, whichever is smaller -health-check-http: "_env:HEALTHCHECK_HTTP:true" +health-check-interval: + matching-cluster-config: "_env:HEALTHCHECK_INTERVAL_MATCHING_CLUSTER_CONFIG:600" + http-reachable: "_env:HEALTHCHECK_INTERVAL_HTTP_REACHABLE:600" + ldap-admins: "_env:HEALTHCHECK_INTERVAL_LDAP_ADMINS:600" + smtp-connect: "_env:HEALTHCHECK_INTERVAL_SMTP_CONNECT:600" + widget-memcached: "_env:HEALTHCHECK_INTERVAL_WIDGET_MEMCACHED:600" health-check-delay-notify: "_env:HEALTHCHECK_DELAY_NOTIFY:true" +health-check-http: "_env:HEALTHCHECK_HTTP:true" # Can we assume, that we can reach ourselves under APPROOT via HTTP (reverse proxies or firewalls might prevent this)? log-settings: detailed: "_env:DETAILED_LOGGING:false" diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg index 4fb54c59b..d7a6a484b 100644 --- a/messages/uniworx/de.msg +++ b/messages/uniworx/de.msg @@ -64,7 +64,7 @@ TermActive: Aktiv SchoolListHeading: Übersicht über verwaltete Institute -SchoolHeading school@SchoolName: Übersicht #{display school} +SchoolHeading school@SchoolName: Übersicht #{school} LectureStart: Beginn Vorlesungen @@ -89,10 +89,10 @@ CourseNewDupShort tid@TermId ssh@SchoolId csh@CourseShorthand: Kurs #{display t CourseEditDupShort tid@TermId ssh@SchoolId csh@CourseShorthand: Kurs #{display tid}-#{display ssh}-#{csh} konnte nicht geändert werden: Es gibt bereits einen anderen Kurs mit dem Kürzel #{csh} in diesem Semester. FFSheetName: Name TermCourseListHeading tid@TermId: Kursübersicht #{display tid} -TermSchoolCourseListHeading tid@TermId school@SchoolName: Kursübersicht #{display tid} für #{display school} +TermSchoolCourseListHeading tid@TermId school@SchoolName: Kursübersicht #{display tid} für #{school} CourseListTitle: Alle Kurse TermCourseListTitle tid@TermId: Kurse #{display tid} -TermSchoolCourseListTitle tid@TermId school@SchoolName: Kurse #{display tid} für #{display school} +TermSchoolCourseListTitle tid@TermId school@SchoolName: Kurse #{display tid} für #{school} CourseNewHeading: Neuen Kurs anlegen CourseEditHeading tid@TermId ssh@SchoolId csh@CourseShorthand: Kurs #{display tid}-#{display ssh}-#{csh} editieren CourseEditTitle: Kurs editieren/anlegen @@ -142,7 +142,7 @@ CourseLecturerRightsIdentical: Alle Sorten von Kursverwalter haben identische Re NoSuchTerm tid@TermId: Semester #{display tid} gibt es nicht. NoSuchSchool ssh@SchoolId: Institut #{display ssh} gibt es nicht. -NoSuchCourseShorthand csh@CourseShorthand: Kein Kurs mit Kürzel #{display csh} bekannt. +NoSuchCourseShorthand csh@CourseShorthand: Kein Kurs mit Kürzel #{csh} bekannt. NoSuchCourse: Keinen passenden Kurs gefunden. Sheet: Blatt @@ -169,6 +169,7 @@ SheetHintFrom: Hinweis ab SheetSolution: Lösung SheetSolutionFrom: Lösung ab SheetMarking: Hinweise für Korrektoren +SheetMarkingFiles: Korrektur SheetType: Wertung SheetInvisible: Dieses Übungsblatt ist für Teilnehmer momentan unsichtbar! SheetInvisibleUntil date@Text: Dieses Übungsblatt ist für Teilnehmer momentan unsichtbar bis #{date}! @@ -186,11 +187,16 @@ SheetMarkingTip: Hinweise zur Korrektur, sichtbar nur für Korrektoren SheetPseudonym: Persönliches Abgabe-Pseudonym SheetGeneratePseudonym: Generieren +SheetFormType: Wertung & Abgabe +SheetFormTimes: Zeiten +SheetFormFiles: Dateien + SheetErrVisibility: "Beginn Abgabezeitraum" muss nach "Sichbar für Teilnehmer ab" liegen SheetErrDeadlineEarly: "Ende Abgabezeitraum" muss nach "Beginn Abzeitraum" liegen SheetErrHintEarly: Hinweise dürfen erst nach Beginn des Abgabezeitraums herausgegeben werden SheetErrSolutionEarly: Lösungen dürfen erst nach Ende der Abgabezeitraums herausgegeben werden - +SheetNoCurrent: Es gibt momentan kein aktives Übungsblatt. +SheetNoOldUnassigned: Alle Abgaben inaktiver Blätter sind bereits einen Korrektor zugeteilt. Deadline: Abgabe Done: Eingereicht @@ -210,6 +216,7 @@ SubmissionFiles: Abgegebene Dateien SubmissionAlreadyExistsFor email@UserEmail: #{email} hat bereits eine Abgabe zu diesem Übungsblatt. SubmissionUsersEmpty: Es kann keine Abgabe ohne Abgebende erstellt werden SubmissionUserAlreadyAdded: Dieser Nutzer ist bereits als Mitabgebende(r) eingetragen +NoOpenSubmissions: Keine unkorrigierten Abgaben vorhanden SubmissionsDeleteQuestion n@Int: Wollen Sie #{pluralDE n "die unten aufgeführte Abgabe" "die unten aufgeführten Abgaben"} wirklich löschen? SubmissionsDeleted n@Int: #{pluralDE n "Abgabe gelöscht" "Abgaben gelöscht"} @@ -387,6 +394,10 @@ UpdatedAssignedCorrectorsAuto num@Int64: #{display num} Abgaben wurden unter den CouldNotAssignCorrectorsAuto num@Int64: #{display num} Abgaben konnten nicht automatisch zugewiesen werden: SelfCorrectors num@Int64: #{display num} Abgaben wurden Abgebenden als eigenem Korrektor zugeteilt! +AssignSubmissionExceptionNoCorrectors: Es sind keine Korrektoren eingestellt +AssignSubmissionExceptionNoCorrectorsByProportion: Es sind keine Korrektoren mit Anteil ungleich Null eingestellt +AssignSubmissionExceptionSubmissionsNotFound n@Int: #{tshow n} Abgaben konnten nicht gefunden werden + CorrectionsUploaded num@Int64: #{display num} Korrekturen wurden gespeichert: NoCorrectionsUploaded: In der hochgeladenen Datei wurden keine Korrekturen gefunden. @@ -443,6 +454,7 @@ SubmissionSinkExceptionDuplicateFileTitle file@FilePath: Dateiname #{show file} SubmissionSinkExceptionDuplicateRating: Mehr als eine Bewertung gefunden. SubmissionSinkExceptionRatingWithoutUpdate: Bewertung gefunden, es ist hier aber keine Bewertung der Abgabe möglich. SubmissionSinkExceptionForeignRating smid@CryptoFileNameSubmission: Fremde Bewertung für Abgabe #{toPathPiece smid} enthalten. Bewertungen müssen sich immer auf die gleiche Abgabe beziehen! +SubmissionSinkExceptionInvalidFileTitleExtension file@FilePath: Dateiname #{show file} hat keine der für dieses Übungsblatt zulässigen Dateiendungen. MultiSinkException name@Text error@Text: In Abgabe #{name} ist ein Fehler aufgetreten: #{error} @@ -486,7 +498,7 @@ LastEdit: Letzte Änderung LastEditByUser: Ihre letzte Bearbeitung NoEditByUser: Nicht von Ihnen bearbeitet -SubmissionFilesIgnored: Es wurden Dateien in der hochgeladenen Abgabe ignoriert: +SubmissionFilesIgnored n@Int: Es #{pluralDE n "wurde" "wurden"} #{tshow n} #{pluralDE n "Datei" "Dateien"} in der hochgeladenen Abgabe ignoriert SubmissionDoesNotExist smid@CryptoFileNameSubmission: Es existiert keine Abgabe mit Nummer #{toPathPiece smid}. LDAPLoginTitle: Campus-Login @@ -505,8 +517,23 @@ DayIsOutOfLecture tid@TermId date@Text: #{date} ist außerhalb der Vorlesungszei DayIsOutOfTerm tid@TermId date@Text: #{date} liegt nicht im #{display tid} UploadModeNone: Kein Upload -UploadModeUnpack: Upload, einzelne Datei -UploadModeNoUnpack: Upload, ZIP-Archive entpacken +UploadModeAny: Upload, beliebige Datei(en) +UploadModeSpecific: Upload, vorgegebene Dateinamen + +UploadModeUnpackZips: Abgabe mehrerer Dateien +UploadModeUnpackZipsTip: Wenn die Abgabe mehrerer Dateien erlaubt ist, werden auch unterstützte Archiv-Formate zugelassen. Diese werden nach dann beim Hochladen automatisch entpackt. + +UploadModeExtensionRestriction: Zulässige Dateiendungen +UploadModeExtensionRestrictionTip: Komma-separiert. Wenn keine Dateiendungen angegeben werden erfolgt keine Einschränkung. +UploadModeExtensionRestrictionEmpty: Liste von zulässigen Dateiendungen darf nicht leer sein + +UploadSpecificFiles: Vorgegebene Dateinamen +NoUploadSpecificFilesConfigured: Wenn der Abgabemodus vorgegebene Dateinamen vorsieht, muss mindestens ein vorgegebener Dateiname konfiguriert werden. +UploadSpecificFilesDuplicateNames: Vorgegebene Dateinamen müssen eindeutig sein +UploadSpecificFilesDuplicateLabels: Bezeichner für vorgegebene Dateinamen müssen eindeutig sein +UploadSpecificFileLabel: Bezeichnung +UploadSpecificFileName: Dateiname +UploadSpecificFileRequired: Zur Abgabe erforderlich NoSubmissions: Keine Abgabe CorrectorSubmissions: Abgabe extern mit Pseudonym @@ -793,8 +820,9 @@ MenuSheetEdit: Übungsblatt editieren MenuSheetDelete: Übungsblatt löschen MenuSheetClone: Als neues Übungsblatt klonen MenuCorrectionsUpload: Korrekturen hochladen +MenuCorrectionsDownload: Offene Abgaben herunterladen MenuCorrectionsCreate: Abgaben registrieren -MenuCorrectionsGrade: Abgaben bewerten +MenuCorrectionsGrade: Abgaben online korrigieren MenuAuthPreds: Authorisierungseinstellungen MenuTutorialDelete: Tutorium löschen MenuTutorialEdit: Tutorium editieren diff --git a/models/exams b/models/exams index af2ac807f..13dbf658e 100644 --- a/models/exams +++ b/models/exams @@ -3,7 +3,7 @@ Exam name (CI Text) gradingKey [Points] -- [n1,n2,n3,...] means 0 <= p < n1 -> p ~= 5, n1 <= p < n2 -> p ~ 4.7, n2 <= p < n3 -> p ~ 4.3, ... bonusRule ExamBonusRule - occuranceRule ExamOccuranceRule + occurrenceRule ExamOccurenceRule registerFrom UTCTime Maybe registerTo UTCTime Maybe deregisterUntil UTCTime Maybe @@ -20,14 +20,14 @@ ExamPart maxPoints Points Maybe weight Rational UniqueExamPart exam name -ExamOccurance +ExamOccurence exam ExamId room Text capacity Natural ExamRegistration exam ExamId user UserId - occurance ExamOccuranceId Maybe + occurance ExamOccurenceId Maybe UniqueExamRegistration exam user ExamResult examPart ExamPartId diff --git a/models/tutorials b/models/tutorials index 444d988cd..4961e0bd5 100644 --- a/models/tutorials +++ b/models/tutorials @@ -11,6 +11,7 @@ Tutorial json deregisterUntil UTCTime Maybe lastChanged UTCTime default=now() UniqueTutorial course name + deriving Generic Tutor tutorial TutorialId user UserId diff --git a/package.yaml b/package.yaml index 5dd414b33..b9561aa88 100644 --- a/package.yaml +++ b/package.yaml @@ -126,6 +126,7 @@ dependencies: - streaming-commons - hourglass - unix + - stm-delay other-extensions: - GeneralizedNewtypeDeriving @@ -185,6 +186,7 @@ ghc-options: - -fno-warn-unrecognised-pragmas - -fno-warn-partial-type-signatures - -fno-max-relevant-binds + - -j3 when: - condition: flag(pedantic) @@ -242,6 +244,7 @@ tests: - uniworx - hspec >=2.0.0 - QuickCheck + - HUnit - yesod-test - conduit-extra - quickcheck-classes diff --git a/routes b/routes index 34a0bb4ff..b1a1214bc 100644 --- a/routes +++ b/routes @@ -95,7 +95,7 @@ /ex SheetListR GET !course-registered !materials !corrector /ex/new SheetNewR GET POST /ex/current SheetCurrentR GET !course-registered !materials !corrector - /ex/unassigned SheetOldUnassigned GET + /ex/unassigned SheetOldUnassignedR GET /ex/#SheetName SheetR: /show SShowR GET !timeANDcourse-registered !timeANDmaterials !corrector !timeANDtutor /edit SEditR GET POST @@ -104,28 +104,27 @@ !/subs/new SubmissionNewR GET POST !timeANDcourse-registeredANDuser-submissions !/subs/own SubmissionOwnR GET !free -- just redirect /subs/#CryptoFileNameSubmission SubmissionR: - / SubShowR GET POST !ownerANDtime !ownerANDread !correctorANDread - /archive/#{ZIPArchiveName SubmissionFileType} SubArchiveR GET !owner !corrector - /delete SubDelR GET POST !ownerANDtime + / SubShowR GET POST !ownerANDtimeANDuser-submissions !ownerANDread !correctorANDread + /delete SubDelR GET POST !ownerANDtimeANDuser-submissions /assign SAssignR GET POST !lecturerANDtime /correction CorrectionR GET POST !corrector !ownerANDreadANDrated - /invite SInviteR GET POST !ownerANDtime + /invite SInviteR GET POST !ownerANDtimeANDuser-submissions + !/#SubmissionFileType SubArchiveR GET !owner !corrector !/#SubmissionFileType/*FilePath SubDownloadR GET !owner !corrector /correctors SCorrR GET POST /iscorrector SIsCorrR GET !corrector -- Route is used to check for corrector access to this sheet /pseudonym SPseudonymR GET POST !course-registeredANDcorrector-submissions /corrector-invite/ SCorrInviteR GET POST + !/#SheetFileType SZipR GET !timeANDcourse-registered !timeANDmaterials !corrector !timeANDtutor !/#SheetFileType/*FilePath SFileR GET !timeANDcourse-registered !timeANDmaterials !corrector !timeANDtutor - !/#{ZIPArchiveName SheetFileType} SZipR GET !timeANDcourse-registered !timeANDmaterials !corrector !timeANDtutor /file MaterialListR GET !course-registered !materials !corrector !tutor /file/new MaterialNewR GET POST /file/#MaterialName MaterialR: /edit MEditR GET POST /delete MDelR GET POST /show MShowR GET !timeANDcourse-registered !timeANDmaterials !corrector !tutor - /load/*FilePath MFileR GET !timeANDcourse-registered !timeANDmaterials !corrector !tutor - /download MArchiveR GET !timeANDcourse-registered !timeANDmaterials !corrector !tutor - /zip MZipR GET !timeANDcourse-registered !timeANDmaterials !corrector !tutor + !/download MArchiveR GET !timeANDcourse-registered !timeANDmaterials !corrector !tutor + !/download/*FilePath MFileR GET !timeANDcourse-registered !timeANDmaterials !corrector !tutor /tuts CTutorialListR GET !tutor -- THIS route is used to check for overall course tutor access! /tuts/new CTutorialNewR GET POST /tuts/#TutorialName TutorialR: @@ -137,10 +136,11 @@ /tutor-invite TInviteR GET POST -/subs CorrectionsR GET POST !corrector !lecturer -/subs/upload CorrectionsUploadR GET POST !corrector !lecturer -/subs/create CorrectionsCreateR GET POST !corrector !lecturer -/subs/grade CorrectionsGradeR GET POST !corrector !lecturer +/subs CorrectionsR GET POST !corrector !lecturer +/subs/upload CorrectionsUploadR GET POST !corrector !lecturer +/subs/create CorrectionsCreateR GET POST !corrector !lecturer +/subs/grade CorrectionsGradeR GET POST !corrector !lecturer +/subs/download CorrectionsDownloadR GET !corrector !lecturer /msgs MessageListR GET POST diff --git a/src/Application.hs b/src/Application.hs index b39657de7..bf7927e51 100644 --- a/src/Application.hs +++ b/src/Application.hs @@ -19,7 +19,7 @@ module Application import Control.Monad.Logger (liftLoc, LoggingT(..), MonadLoggerIO(..)) import Database.Persist.Postgresql (createPostgresqlPool, pgConnStr, pgPoolSize, runSqlPool) -import Import +import Import hiding (cancel) import Language.Haskell.TH.Syntax (qLocation) import Network.Wai (Middleware) import Network.Wai.Handler.Warp (Settings, defaultSettings, @@ -75,17 +75,22 @@ import System.Exit import qualified Database.Memcached.Binary.IO as Memcached import qualified System.Systemd.Daemon as Systemd -import Control.Concurrent.Async.Lifted.Safe (async, waitAnyCancel) +import Control.Concurrent.Async.Lifted.Safe import System.Environment (lookupEnv) import System.Posix.Process (getProcessID) import System.Posix.Signals (SignalInfo(..), installHandler, sigTERM) import qualified System.Posix.Signals as Signals (Handler(..)) -import Control.Monad.Trans.State (execStateT) - import Network (socketPort) import qualified Network.Socket as Socket (close) +import Control.Concurrent.STM.Delay +import Control.Monad.STM (retry) + +import qualified Data.Set as Set + +import Data.Semigroup (Max(..), Min(..)) + -- Import all relevant handler modules here. -- (HPack takes care to add new modules to our cabal file nowadays.) import Handler.Common @@ -152,7 +157,7 @@ makeFoundation appSettings'@AppSettings{..} = do appJobCtl <- liftIO $ newTVarIO Map.empty appCronThread <- liftIO newEmptyTMVarIO - appHealthReport <- liftIO $ newTVarIO Nothing + appHealthReport <- liftIO $ newTVarIO Set.empty -- We need a log function to create a connection pool. We need a connection -- pool to create our foundation. And we need our foundation to get a @@ -333,7 +338,12 @@ warpSettings foundation = defaultSettings if | foundation ^. _appHealthCheckDelayNotify -> void . fork $ do - atomically $ readTVar (foundation ^. _appHealthReport) >>= guard . maybe False ((== HealthSuccess) . classifyHealthReport . snd) + let activeChecks = Set.fromList universeF + & Set.filter (is _Just . (foundation ^. _appHealthCheckInterval)) + atomically $ do + results <- readTVar $ foundation ^. _appHealthReport + guard $ activeChecks == Set.map (classifyHealthReport . snd) results + guard . (== Min HealthSuccess) $ foldMap (Min . healthReportStatus . snd) results notifyReady | otherwise -> notifyReady @@ -354,19 +364,8 @@ warpSettings foundation = defaultSettings getAppDevSettings, getAppSettings :: MonadIO m => m AppSettings -getAppDevSettings = liftIO $ adjustSettings =<< loadYamlSettings [configSettingsYml] [configSettingsYmlValue] useEnv -getAppSettings = liftIO $ adjustSettings =<< loadYamlSettingsArgs [configSettingsYmlValue] useEnv - -adjustSettings :: MonadIO m => AppSettings -> m AppSettings -adjustSettings = execStateT $ do - watchdogMicroSec <- liftIO $ (>>= readMay) <$> lookupEnv "WATCHDOG_USEC" - watchdogProcess <- liftIO $ (>>= fmap fromInteger . readMay) <$> lookupEnv "WATCHDOG_PID" - myProcessID <- liftIO getProcessID - case watchdogMicroSec of - Just wInterval - | maybe True (== myProcessID) watchdogProcess - -> _appHealthCheckInterval %= min (fromRational $ (toRational wInterval / 1e6) / 2) - _other -> return () +getAppDevSettings = liftIO $ loadYamlSettings [configSettingsYml] [configSettingsYmlValue] useEnv +getAppSettings = liftIO $ loadYamlSettingsArgs [configSettingsYmlValue] useEnv -- | main function for use by yesod devel develMain :: IO () @@ -417,7 +416,47 @@ appMain = runResourceT $ do case didStore of Just () -> $logInfoS "shutdown" "Stored all bound sockets for restart" Nothing -> forM_ sockets $ liftIO . Socket.close - liftIO . throwTo mainThreadId . ExitFailure $ 0b10000000 + fromIntegral siginfoSignal + liftIO $ throwTo mainThreadId ExitSuccess + + watchdogMicroSec <- liftIO $ (>>= readMay) <$> lookupEnv "WATCHDOG_USEC" + watchdogProcess <- liftIO $ (>>= fmap fromInteger . readMay) <$> lookupEnv "WATCHDOG_PID" + myProcessID <- liftIO getProcessID + case watchdogMicroSec of + Just wInterval + | maybe True (== myProcessID) watchdogProcess + -> let notifyWatchdog :: IO () + notifyWatchdog = runAppLoggingT foundation $ go Nothing + where + go pStatus = do + d <- liftIO . newDelay . floor $ wInterval % 2 + + status <- atomically $ asum + [ Nothing <$ waitDelay d + , Just <$> do + results <- readTVar $ foundation ^. _appHealthReport + case fromNullable results of + Nothing -> retry + Just rs -> do + let status = ofoldMap1 (Max *** Min . healthReportStatus) rs + guard $ pStatus /= Just status + return status + ] + + case status of + Just (_, Min status') -> do + $logInfoS "NotifyStatus" $ toPathPiece status' + liftIO . void . Systemd.notifyStatus . unpack $ toPathPiece status' + Nothing -> return () + + case status of + Just (_, Min HealthSuccess) -> do + $logInfoS "NotifyWatchdog" "Notify" + liftIO $ void Systemd.notifyWatchdog + _other -> return () + + go status + in void $ allocate (async notifyWatchdog >>= \a -> a <$ link a) cancel + _other -> return () let runWarp socket = runSettingsSocket (warpSettings foundation) socket app case sockets of diff --git a/src/Data/Aeson/Types/Instances.hs b/src/Data/Aeson/Types/Instances.hs index 66ff1df61..4e87d05a9 100644 --- a/src/Data/Aeson/Types/Instances.hs +++ b/src/Data/Aeson/Types/Instances.hs @@ -14,9 +14,13 @@ import Data.Binary (Binary) import Data.HashMap.Strict.Instances () import Data.Vector.Instances () +import Model.Types.TH.JSON (derivePersistFieldJSON) + instance MonadThrow Parser where throwM = fail . show - instance Binary Value + + +derivePersistFieldJSON ''Value diff --git a/src/Data/Time/Calendar/Instances.hs b/src/Data/Time/Calendar/Instances.hs new file mode 100644 index 000000000..395f455f8 --- /dev/null +++ b/src/Data/Time/Calendar/Instances.hs @@ -0,0 +1,18 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} + +module Data.Time.Calendar.Instances + ( + ) where + +import ClassyPrelude +import Data.Binary (Binary) +import qualified Data.Binary as Binary + + +deriving newtype instance Hashable Day + +instance Binary Day where + get = ModifiedJulianDay <$> Binary.get + put = Binary.put . toModifiedJulianDay + diff --git a/src/Data/Time/Clock/Instances.hs b/src/Data/Time/Clock/Instances.hs index 1783ac465..b9721ab7d 100644 --- a/src/Data/Time/Clock/Instances.hs +++ b/src/Data/Time/Clock/Instances.hs @@ -11,14 +11,17 @@ import Data.Time.Clock import Data.Binary (Binary) import qualified Data.Binary as Binary +import Data.Time.Calendar.Instances () + + +instance Hashable DiffTime where + hashWithSalt s = hashWithSalt s . toRational + deriving instance Generic UTCTime +instance Hashable UTCTime -instance Binary Day where - get = ModifiedJulianDay <$> Binary.get - put = Binary.put . toModifiedJulianDay - instance Binary DiffTime where get = fromRational <$> Binary.get put = Binary.put . toRational diff --git a/src/Data/Time/Format/Instances.hs b/src/Data/Time/Format/Instances.hs new file mode 100644 index 000000000..dd2d68144 --- /dev/null +++ b/src/Data/Time/Format/Instances.hs @@ -0,0 +1,14 @@ +{-# OPTIONS -fno-warn-orphans #-} + +module Data.Time.Format.Instances + ( + ) where + +import qualified Language.Haskell.TH.Syntax as TH + +import Data.Time.Format + +import Data.Time.LocalTime.Instances () + + +deriving instance TH.Lift TimeLocale diff --git a/src/Data/Time/LocalTime/Instances.hs b/src/Data/Time/LocalTime/Instances.hs new file mode 100644 index 000000000..39c0d70f0 --- /dev/null +++ b/src/Data/Time/LocalTime/Instances.hs @@ -0,0 +1,23 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} + +module Data.Time.LocalTime.Instances + ( + ) where + +import ClassyPrelude + +import Data.Time.LocalTime + +import Data.Binary (Binary) + +import qualified Language.Haskell.TH.Syntax as TH + + +deriving instance Generic TimeOfDay +deriving instance Typeable TimeOfDay + +instance Hashable TimeOfDay +instance Binary TimeOfDay + + +deriving instance TH.Lift TimeZone diff --git a/src/Data/UUID/Instances.hs b/src/Data/UUID/Instances.hs new file mode 100644 index 000000000..8a00de5e3 --- /dev/null +++ b/src/Data/UUID/Instances.hs @@ -0,0 +1,27 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} + +module Data.UUID.Instances + () where + +import ClassyPrelude +import Data.UUID (UUID) +import qualified Data.UUID as UUID + +import Database.Persist.Sql +import Web.PathPieces + + +instance PathPiece UUID where + fromPathPiece = UUID.fromString . unpack + toPathPiece = pack . UUID.toString + +instance PersistField UUID where + toPersistValue = PersistDbSpecific . UUID.toASCIIBytes + + fromPersistValue (PersistText t) = maybe (Left "Failed to parse UUID") Right $ UUID.fromText t + fromPersistValue (PersistByteString bs) = maybe (Left "Failed to parse UUID") Right $ UUID.fromASCIIBytes bs + fromPersistValue (PersistDbSpecific bs) = maybe (Left "Failed to parse UUID") Right $ UUID.fromASCIIBytes bs + fromPersistValue x = Left $ "Expected UUID, received: " <> tshow x + +instance PersistFieldSql UUID where + sqlType _ = SqlOther "uuid" diff --git a/src/Data/Universe/Instances/Reverse/MonoTraversable.hs b/src/Data/Universe/Instances/Reverse/MonoTraversable.hs new file mode 100644 index 000000000..aaa50ca73 --- /dev/null +++ b/src/Data/Universe/Instances/Reverse/MonoTraversable.hs @@ -0,0 +1,17 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} + +module Data.Universe.Instances.Reverse.MonoTraversable + ( + ) where + +import Data.Universe +import Data.MonoTraversable + +import Data.Universe.Instances.Reverse + + +type instance Element (a -> b) = b + +instance Finite a => MonoFoldable (a -> b) +instance (Ord a, Finite a) => MonoTraversable (a -> b) + diff --git a/src/Database/Esqueleto/Utils/TH.hs b/src/Database/Esqueleto/Utils/TH.hs index 218c96d70..52cd68cdc 100644 --- a/src/Database/Esqueleto/Utils/TH.hs +++ b/src/Database/Esqueleto/Utils/TH.hs @@ -50,7 +50,8 @@ sqlInTuple arity = do ] -- | Generic unValuing of Tuples of Values, i.e. --- $(unValueN 3) :: (E.Value a, E.Value b, E.Value c) -> (a,b,c) +-- +-- > $(unValueN 3) :: (E.Value a, E.Value b, E.Value c) -> (a,b,c) unValueN :: Int -> ExpQ unValueN arity = do vs <- replicateM arity $ newName "v" @@ -60,7 +61,8 @@ unValueN arity = do lam1E pat rhs -- | Generic unValuing of certain indices of a Tuple, i.e. --- $(unValueNIs 3 [1,3]) :: (E.Value a, b, E.Value c) -> (a,b,c) +-- +-- > $(unValueNIs 3 [1,3]) :: (E.Value a, b, E.Value c) -> (a,b,c) unValueNIs :: Int -> [Int] -> ExpQ unValueNIs arity uvIdx = do vs <- replicateM arity $ newName "v" @@ -74,8 +76,9 @@ unValueNIs arity uvIdx = do -- | Generic projections for InnerJoin-tuples --- gives I-th element of N-tuple of left-associative InnerJoin-pairs, --- i.e. @$(projN n m) :: (t1 `E.InnerJoin` .. `E.InnerJoin` tn) -> tm@ (for m<=n) +-- gives I-th element of N-tuple of left-associative InnerJoin-pairs, i.e. +-- +-- > $(projN n m) :: (t1 `E.InnerJoin` .. `E.InnerJoin` tn) -> tm@ (for m<=n) sqlIJproj :: Int -> Int -> ExpQ sqlIJproj = leftAssociativePairProjection 'E.InnerJoin diff --git a/src/Database/Persist/Class/Instances.hs b/src/Database/Persist/Class/Instances.hs new file mode 100644 index 000000000..4864f0df3 --- /dev/null +++ b/src/Database/Persist/Class/Instances.hs @@ -0,0 +1,22 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} + +module Database.Persist.Class.Instances + ( + ) where + +import ClassyPrelude + +import Database.Persist.Class +import Database.Persist.Types.Instances () + +import Data.Binary (Binary) +import qualified Data.Binary as Binary + + +instance PersistEntity record => Hashable (Key record) where + hashWithSalt s = hashWithSalt s . toPersistValue + +instance PersistEntity record => Binary (Key record) where + put = Binary.put . toPersistValue + putList = Binary.putList . map toPersistValue + get = either (fail . unpack) return . fromPersistValue =<< Binary.get diff --git a/src/Database/Persist/Sql/Instances.hs b/src/Database/Persist/Sql/Instances.hs deleted file mode 100644 index 2d0044164..000000000 --- a/src/Database/Persist/Sql/Instances.hs +++ /dev/null @@ -1,33 +0,0 @@ -{-# LANGUAGE UndecidableInstances #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} - -module Database.Persist.Sql.Instances - ( - ) where - -import ClassyPrelude.Yesod - -import Data.Binary (Binary) -import qualified Data.Binary as B - -import Database.Persist.Sql - - -instance Binary (BackendKey SqlWriteBackend) where - put = B.put . unSqlWriteBackendKey - putList = B.putList . map unSqlWriteBackendKey - get = SqlWriteBackendKey <$> B.get -instance Binary (BackendKey SqlReadBackend) where - put = B.put . unSqlReadBackendKey - putList = B.putList . map unSqlReadBackendKey - get = SqlReadBackendKey <$> B.get -instance Binary (BackendKey SqlBackend) where - put = B.put . unSqlBackendKey - putList = B.putList . map unSqlBackendKey - get = SqlBackendKey <$> B.get - - -instance {-# OVERLAPPABLE #-} ToBackendKey SqlBackend record => Binary (Key record) where - put = B.put . fromSqlKey - putList = B.putList . map fromSqlKey - get = toSqlKey <$> B.get diff --git a/src/Database/Persist/Types/Instances.hs b/src/Database/Persist/Types/Instances.hs index db5957d54..eb02f5a22 100644 --- a/src/Database/Persist/Types/Instances.hs +++ b/src/Database/Persist/Types/Instances.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Database.Persist.Types.Instances @@ -6,7 +5,18 @@ module Database.Persist.Types.Instances ) where import ClassyPrelude + import Database.Persist.Types -instance (Hashable record, Hashable (Key record)) => Hashable (Entity record) where - s `hashWithSalt` Entity{..} = s `hashWithSalt` entityKey `hashWithSalt` entityVal +import Data.Time.Calendar.Instances () +import Data.Time.LocalTime.Instances () +import Data.Time.Clock.Instances () + +import Data.Binary (Binary) + + +deriving instance Generic PersistValue +deriving instance Typeable PersistValue + +instance Hashable PersistValue +instance Binary PersistValue diff --git a/src/Foundation.hs b/src/Foundation.hs index 11c865ef9..b3826a51a 100644 --- a/src/Foundation.hs +++ b/src/Foundation.hs @@ -130,7 +130,7 @@ data UniWorX = UniWorX , appSessionKey :: ClientSession.Key , appSecretBoxKey :: SecretBox.Key , appJSONWebKeySet :: Jose.JwkSet - , appHealthReport :: TVar (Maybe (UTCTime, HealthReport)) + , appHealthReport :: TVar (Set (UTCTime, HealthReport)) } makeLenses_ ''UniWorX @@ -280,18 +280,12 @@ embedRenderMessage ''UniWorX ''SubmissionModeDescr verbMap [_, _, v] = v <> "Submissions" verbMap _ = error "Invalid number of verbs" in verbMap . splitCamel +embedRenderMessage ''UniWorX ''UploadModeDescr id +embedRenderMessage ''UniWorX ''SecretJSONFieldException id newtype SheetTypeHeader = SheetTypeHeader SheetType embedRenderMessageVariant ''UniWorX ''SheetTypeHeader ("SheetType" <>) -instance RenderMessage UniWorX UploadMode where - renderMessage foundation ls uploadMode = case uploadMode of - NoUpload -> mr MsgUploadModeNone - Upload False -> mr MsgUploadModeNoUnpack - Upload True -> mr MsgUploadModeUnpack - where - mr = renderMessage foundation ls - instance RenderMessage UniWorX SheetType where renderMessage foundation ls sheetType = case sheetType of NotGraded -> mr $ SheetTypeHeader NotGraded @@ -677,10 +671,10 @@ tagAccessPredicate AuthTime = APDB $ \mAuthId route _ -> case route of SFileR SheetSolution _ -> guard $ maybe False (<= cTime) sheetSolutionFrom SFileR _ _ -> mzero -- Archives of SheetFileType - SZipR (ZIPArchiveName SheetExercise) -> guard $ sheetActiveFrom <= cTime - SZipR (ZIPArchiveName SheetHint ) -> guard $ maybe False (<= cTime) sheetHintFrom - SZipR (ZIPArchiveName SheetSolution) -> guard $ maybe False (<= cTime) sheetSolutionFrom - SZipR _ -> mzero + SZipR SheetExercise -> guard $ sheetActiveFrom <= cTime + SZipR SheetHint -> guard $ maybe False (<= cTime) sheetHintFrom + SZipR SheetSolution -> guard $ maybe False (<= cTime) sheetSolutionFrom + SZipR _ -> mzero -- Submissions SubmissionNewR -> guard active SubmissionR _ SAssignR -> guard marking -- Correctors can only be assigned when the Sheet is inactive, since submissions are subject to change @@ -1120,7 +1114,7 @@ instance Yesod UniWorX where lift . bracketOnError getMessages (mapM_ $ uncurry Yesod.addMessage) $ \msgs -> do Just msgs' <- return . forM msgs $ \(msgState, content) -> Message <$> fromPathPiece msgState <*> return content - addCustomHeader HeaderAlerts . decodeUtf8 $ JSON.encode msgs' + addCustomHeader HeaderAlerts . decodeUtf8 . urlEncode True . toStrict $ JSON.encode msgs' -- Since we implement `errorHandler` ourselves we don't need `defaultMessageWidget` defaultMessageWidget _title _body = error "defaultMessageWidget: undefined" @@ -1340,6 +1334,7 @@ siteLayout' headingOverride widget = do addScript $ StaticR js_polyfills_urlPolyfill_js -- JavaScript services addScript $ StaticR js_services_utilRegistry_js + addScript $ StaticR js_services_htmlHelpers_js addScript $ StaticR js_services_httpClient_js addScript $ StaticR js_services_i18n_js -- JavaScript utils @@ -1393,12 +1388,8 @@ applySystemMessages = liftHandlerT . runDB . runConduit $ selectSource [] [] .| Nothing -> (systemMessageSummary, systemMessageContent) Just SystemMessageTranslation{..} -> (systemMessageTranslationSummary, systemMessageTranslationContent) case summary of - Just s -> do - html <- withUrlRenderer [hamlet| - - #{s} - |] - addMessage systemMessageSeverity html + Just s -> + addMessageWidget systemMessageSeverity $ msgModal (toWidget s) (Left . SomeRoute $ MessageR cID) Nothing -> addMessage systemMessageSeverity content -- Define breadcrumbs. @@ -1450,6 +1441,8 @@ instance YesodBreadcrumbs UniWorX where breadcrumb (CourseR tid ssh csh CCorrectionsR) = return ("Abgaben" , Just $ CourseR tid ssh csh CShowR) breadcrumb (CourseR tid ssh csh SheetListR) = return ("Übungen" , Just $ CourseR tid ssh csh CShowR) breadcrumb (CourseR tid ssh csh SheetNewR ) = return ("Neu", Just $ CourseR tid ssh csh SheetListR) + breadcrumb (CourseR tid ssh csh SheetCurrentR) = return ("Aktuelles Blatt", Just $ CourseR tid ssh csh SheetListR) + breadcrumb (CourseR tid ssh csh SheetOldUnassignedR) = return ("Offene Abgaben", Just $ CourseR tid ssh csh SheetListR) breadcrumb (CourseR tid ssh csh CCommR ) = return ("Kursmitteilung", Just $ CourseR tid ssh csh CShowR) breadcrumb (CourseR tid ssh csh CTutorialListR) = return ("Tutorien", Just $ CourseR tid ssh csh CShowR) breadcrumb (CourseR tid ssh csh CTutorialNewR) = return ("Anlegen", Just $ CourseR tid ssh csh CTutorialListR) @@ -1949,7 +1942,7 @@ pageActions (CourseR tid ssh csh SheetListR) = { menuItemType = PageActionPrime , menuItemLabel = MsgMenuSheetOldUnassigned , menuItemIcon = Nothing - , menuItemRoute = SomeRoute $ CourseR tid ssh csh SheetOldUnassigned + , menuItemRoute = SomeRoute $ CourseR tid ssh csh SheetOldUnassignedR , menuItemModal = False , menuItemAccessCallback' = runDB . maybeT (return False) $ do void . MaybeT $ sheetOldUnassigned tid ssh csh @@ -2231,17 +2224,25 @@ pageActions (CSheetR tid ssh csh shn SCorrR) = ] pageActions (CorrectionsR) = [ MenuItem - { menuItemType = PageActionPrime + { menuItemType = PageActionPrime + , menuItemLabel = MsgMenuCorrectionsDownload + , menuItemIcon = Nothing + , menuItemRoute = SomeRoute CorrectionsDownloadR + , menuItemModal = False + , menuItemAccessCallback' = return True + } + , MenuItem + { menuItemType = PageActionPrime , menuItemLabel = MsgMenuCorrectionsUpload - , menuItemIcon = Nothing + , menuItemIcon = Nothing , menuItemRoute = SomeRoute CorrectionsUploadR , menuItemModal = True , menuItemAccessCallback' = return True } , MenuItem - { menuItemType = PageActionPrime + { menuItemType = PageActionPrime , menuItemLabel = MsgMenuCorrectionsCreate - , menuItemIcon = Nothing + , menuItemIcon = Nothing , menuItemRoute = SomeRoute CorrectionsCreateR , menuItemModal = False , menuItemAccessCallback' = runDB . maybeT (return False) $ do diff --git a/src/Handler/Admin.hs b/src/Handler/Admin.hs index 7a7cc36f8..6f13dba0c 100644 --- a/src/Handler/Admin.hs +++ b/src/Handler/Admin.hs @@ -2,7 +2,6 @@ module Handler.Admin where import Import import Handler.Utils -import Handler.Utils.Form.MassInput import Jobs import Data.Aeson.Encode.Pretty (encodePrettyToTextBuilder) @@ -261,7 +260,11 @@ postAdminErrMsgR = do [whamlet| $maybe t <- plaintext 
-          #{encodePrettyToTextBuilder t}
+          $case t
+            $of String t'
+              #{t'}
+            $of t'
+              #{encodePrettyToTextBuilder t'}
 
       ^{ctView'}
     |]
diff --git a/src/Handler/Corrections.hs b/src/Handler/Corrections.hs
index 15646baea..ca358a335 100644
--- a/src/Handler/Corrections.hs
+++ b/src/Handler/Corrections.hs
@@ -36,6 +36,7 @@ import Data.Monoid (All(..))
 -- import qualified Data.Conduit.List as C
 
 import qualified Database.Esqueleto as E
+import qualified Database.Esqueleto.Internal.Language (From)
 -- import qualified Database.Esqueleto.Internal.Sql as E
 
 -- import Control.Monad.Writer (MonadWriter(..), execWriterT)
@@ -60,7 +61,7 @@ import Data.Foldable (foldrM)
 
 type CorrectionTableExpr  = (E.SqlExpr (Entity Course) `E.InnerJoin` E.SqlExpr (Entity Sheet) `E.InnerJoin` E.SqlExpr (Entity Submission)) `E.LeftOuterJoin` E.SqlExpr (Maybe (Entity User))
 type CorrectionTableWhere = CorrectionTableExpr -> E.SqlExpr (E.Value Bool)
-type CorrectionTableData = DBRow (Entity Submission, Entity Sheet, (CourseName, CourseShorthand, Key Term, Key School), Maybe (Entity User), Map UserId (User, Maybe Pseudonym))
+type CorrectionTableData = DBRow (Entity Submission, Entity Sheet, (CourseName, CourseShorthand, Key Term, Key School), Maybe (Entity User), Maybe UTCTime, Map UserId (User, Maybe Pseudonym))
 
 correctionsTableQuery :: CorrectionTableWhere -> (CorrectionTableExpr -> v) -> CorrectionTableExpr -> E.SqlQuery v
 correctionsTableQuery whereClause returnStatement t@((course `E.InnerJoin` sheet `E.InnerJoin` submission) `E.LeftOuterJoin` corrector) = do
@@ -70,6 +71,12 @@ correctionsTableQuery whereClause returnStatement t@((course `E.InnerJoin` sheet
     E.where_ $ whereClause t
     return $ returnStatement t
 
+lastEditQuery :: Database.Esqueleto.Internal.Language.From query expr backend (expr (Entity SubmissionEdit))
+  => expr (Entity Submission) -> expr (E.Value (Maybe UTCTime))
+lastEditQuery submission = E.sub_select $ E.from $ \edit -> do
+  E.where_ $ edit E.^. SubmissionEditSubmission E.==. submission E.^. SubmissionId
+  return $ E.max_ $ edit E.^. SubmissionEditTime
+
 -- Where Clauses
 ratedBy :: UserId -> CorrectionTableWhere
 ratedBy uid   ((_course `E.InnerJoin` _sheet `E.InnerJoin`  submission) `E.LeftOuterJoin` _corrector) = submission E.^. SubmissionRatingBy E.==. E.just (E.val uid)
@@ -84,40 +91,41 @@ sheetIs shid  ((_course `E.InnerJoin`  sheet `E.InnerJoin` _submission) `E.LeftO
 -- Columns
 colTerm :: IsDBTable m a => Colonnade Sortable CorrectionTableData (DBCell m a)
 colTerm = sortable (Just "term") (i18nCell MsgTerm)
-        $ \DBRow{ dbrOutput=(_, _, course, _, _) } ->
-          -- cell [whamlet| _{untermKey $ course ^. _3}|]   -- lange, internationale Semester
-          textCell $ termToText $ unTermKey $ course ^. _3 -- kurze Semsterkürzel
+        $ \DBRow{ dbrOutput } ->
+          textCell $ termToText $ unTermKey $ dbrOutput ^. _3 . _3 -- kurze Semsterkürzel
 
 colSchool :: IsDBTable m a => Colonnade Sortable CorrectionTableData (DBCell m a)
 colSchool = sortable (Just "school") (i18nCell MsgCourseSchool)
-          $ \DBRow{ dbrOutput=(_, _, course, _, _) } ->
+          $ \DBRow{ dbrOutput } -> let course = dbrOutput ^. _3 in
             anchorCell (TermSchoolCourseListR (course ^. _3) (course ^. _4)) [whamlet|#{unSchoolKey (course ^. _4)}|]
 
 colCourse :: IsDBTable m a => Colonnade Sortable CorrectionTableData (DBCell m a)
 colCourse = sortable (Just "course") (i18nCell MsgCourse)
-        $ \DBRow{ dbrOutput=(_, _, (_,csh,tid,sid), _, _) } -> courseCellCL (tid,sid,csh)
+        $ \DBRow{ dbrOutput=(_, _, (_,csh,tid,sid),_ , _, _) } -> courseCellCL (tid,sid,csh)
 
 colSheet :: IsDBTable m a => Colonnade Sortable CorrectionTableData (DBCell m a)
-colSheet = sortable (Just "sheet") (i18nCell MsgSheet)
-        $ \DBRow{ dbrOutput=(_, sheet, course, _, _) } ->
-          let tid   = course ^. _3
+colSheet = sortable (Just "sheet") (i18nCell MsgSheet) $ \row ->
+          let sheet = row ^. _dbrOutput . _2
+              course= row ^. _dbrOutput . _3
+              tid   = course ^. _3
               ssh   = course ^. _4
               csh   = course ^. _2
               shn   = sheetName $ entityVal sheet
           in anchorCell (CSheetR tid ssh csh shn SShowR) [whamlet|#{display shn}|]
 
 colSheetType :: IsDBTable m a => Colonnade Sortable CorrectionTableData (DBCell m a)
-colSheetType = sortable (toNothing "sheetType") (i18nCell MsgSheetType)
-        $ \DBRow{ dbrOutput=(_, sheet, _, _, _) } -> i18nCell . sheetType $ entityVal sheet
+colSheetType = sortable (toNothing "sheetType") (i18nCell MsgSheetType) $
+        i18nCell . sheetType <$> view (_dbrOutput . _2 . _entityVal)
+        -- \DBRow{ dbrOutput=(_, sheet, _, _, _, _) } -> i18nCell . sheetType $ entityVal sheet
 
 colCorrector :: IsDBTable m a => Colonnade Sortable CorrectionTableData (DBCell m a)
 colCorrector = sortable (Just "corrector") (i18nCell MsgCorrector) $ \case
-  DBRow{ dbrOutput = (_, _, _, Nothing  , _) } -> cell mempty
-  DBRow{ dbrOutput = (_, _, _, Just (Entity _ User{..}), _) } -> userCell userDisplayName userSurname
+  DBRow{ dbrOutput = (_, _, _, Nothing  , _, _) } -> cell mempty
+  DBRow{ dbrOutput = (_, _, _, Just (Entity _ User{..}), _, _) } -> userCell userDisplayName userSurname
 
 colSubmissionLink :: IsDBTable m a => Colonnade Sortable CorrectionTableData (DBCell m a)
 colSubmissionLink = sortable Nothing (i18nCell MsgSubmission)
-        $ \DBRow{ dbrOutput=(submission, sheet, course, _, _) } ->
+        $ \DBRow{ dbrOutput=(submission, sheet, course, _, _,_) } ->
           let csh = course ^. _2
               tid = course ^. _3
               ssh = course ^. _4
@@ -129,10 +137,10 @@ colSubmissionLink = sortable Nothing (i18nCell MsgSubmission)
           in anchorCellM mkRoute (mkCid >>= \cid -> [whamlet|#{display cid}|])
 
 colSelect :: forall act h. (Semigroup act, Monoid act, Headedness h) => Colonnade h CorrectionTableData (DBCell _ (FormResult (act, DBFormResult CryptoFileNameSubmission Bool CorrectionTableData), SheetTypeSummary))
-colSelect = dbSelect (_1 . applying _2) id $ \DBRow{ dbrOutput=(Entity subId _, _, _, _, _) } -> encrypt subId
+colSelect = dbSelect (_1 . applying _2) id $ \DBRow{ dbrOutput=(Entity subId _, _, _, _, _, _) } -> encrypt subId
 
 colSubmittors :: IsDBTable m a => Colonnade Sortable CorrectionTableData (DBCell m a)
-colSubmittors = sortable (Just "submittors") (i18nCell MsgSubmissionUsers) $ \DBRow{ dbrOutput=(_, _, course, _, users) } -> let
+colSubmittors = sortable (Just "submittors") (i18nCell MsgSubmissionUsers) $ \DBRow{ dbrOutput=(_, _, course, _, _, users) } -> let
   csh = course ^. _2
   tid = course ^. _3
   ssh = course ^. _4
@@ -144,12 +152,12 @@ colSubmittors = sortable (Just "submittors") (i18nCell MsgSubmissionUsers) $ \DB
   in protoCell & cellAttrs <>~ [("class", "list--inline list--comma-separated")]
 
 colSMatrikel :: IsDBTable m a => Colonnade Sortable CorrectionTableData (DBCell m a)
-colSMatrikel = sortable Nothing (i18nCell MsgMatrikelNr) $ \DBRow{ dbrOutput=(_, _, _, _, users) } -> let
+colSMatrikel = sortable Nothing (i18nCell MsgMatrikelNr) $ \DBRow{ dbrOutput=(_, _, _, _, _, users) } -> let
   protoCell = listCell (Map.toList users) $ \(userId, (User{..}, _)) -> anchorCellM (AdminUserR <$> encrypt userId) (maybe mempty toWidget userMatrikelnummer)
   in protoCell & cellAttrs <>~ [("class", "list--inline list--comma-separated")]
 
 colRating :: forall m a. IsDBTable m (a, SheetTypeSummary) => Colonnade Sortable CorrectionTableData (DBCell m (a, SheetTypeSummary))
-colRating = sortable (Just "rating") (i18nCell MsgRating) $ \DBRow{ dbrOutput=(Entity subId sub@Submission{..}, Entity _ Sheet{..}, course, _, _) } ->
+colRating = sortable (Just "rating") (i18nCell MsgRating) $ \DBRow{ dbrOutput=(Entity subId sub@Submission{..}, Entity _ Sheet{..}, course, _, _, _) } ->
   let csh = course ^. _2
       tid = course ^. _3
       ssh = course ^. _4
@@ -169,36 +177,40 @@ colRating = sortable (Just "rating") (i18nCell MsgRating) $ \DBRow{ dbrOutput=(E
      ]
 
 colAssigned :: IsDBTable m a => Colonnade Sortable CorrectionTableData (DBCell m a)
-colAssigned = sortable (Just "assignedtime") (i18nCell MsgAssignedTime) $ \DBRow{ dbrOutput=(Entity _subId Submission{..}, _sheet, _course, _, _) } ->
+colAssigned = sortable (Just "assignedtime") (i18nCell MsgAssignedTime) $ \DBRow{ dbrOutput=(Entity _subId Submission{..}, _sheet, _course, _, _, _) } ->
   maybe mempty dateTimeCell submissionRatingAssigned
 
 colRated :: IsDBTable m a => Colonnade Sortable CorrectionTableData (DBCell m a)
-colRated = sortable (Just "ratingtime") (i18nCell MsgRatingTime) $ \DBRow{ dbrOutput=(Entity _subId Submission{..}, _sheet, _course, _, _) } ->
+colRated = sortable (Just "ratingtime") (i18nCell MsgRatingTime) $ \DBRow{ dbrOutput=(Entity _subId Submission{..}, _sheet, _course, _, _, _) } ->
   maybe mempty dateTimeCell submissionRatingTime
 
 colPseudonyms :: IsDBTable m a => Colonnade Sortable CorrectionTableData (DBCell m a)
-colPseudonyms = sortable Nothing (i18nCell MsgPseudonyms) $ \DBRow{ dbrOutput=(_, _, _, _, users) } -> let
+colPseudonyms = sortable Nothing (i18nCell MsgPseudonyms) $ \DBRow{ dbrOutput=(_, _, _, _, _, users) } -> let
     lCell = listCell (catMaybes $ snd . snd <$> Map.toList users) $ \pseudo ->
       cell [whamlet|#{review _PseudonymText pseudo}|]
   in lCell & cellAttrs <>~ [("class", "list--inline list--comma-separated")]
 
 colRatedField :: Colonnade Sortable CorrectionTableData (DBCell _ (FormResult (DBFormResult SubmissionId (Bool, a, b) CorrectionTableData)))
 colRatedField = sortable Nothing (i18nCell MsgRatingDone) $ formCell id
-  (\DBRow{ dbrOutput=(Entity subId _, _, _, _, _) } -> return subId)
-  (\DBRow{ dbrOutput=(Entity _ (submissionRatingDone -> done), _, _, _, _) } mkUnique -> over (_1.mapped) (_1 .~) . over _2 fvInput <$> mreq checkBoxField (fsUniq mkUnique "rated") (Just done))
+  (\DBRow{ dbrOutput=(Entity subId _, _, _, _, _, _) } -> return subId)
+  (\DBRow{ dbrOutput=(Entity _ (submissionRatingDone -> done), _, _, _, _, _) } mkUnique -> over (_1.mapped) (_1 .~) . over _2 fvInput <$> mreq checkBoxField (fsUniq mkUnique "rated") (Just done))
 
 colPointsField :: Colonnade Sortable CorrectionTableData (DBCell _ (FormResult (DBFormResult SubmissionId (a, Maybe Points, b) CorrectionTableData)))
 colPointsField = sortable (Just "rating") (i18nCell MsgColumnRatingPoints) $ formCell id
-  (\DBRow{ dbrOutput=(Entity subId _, _, _, _, _) } -> return subId)
-  (\DBRow{ dbrOutput=(Entity _ Submission{..}, Entity _ Sheet{..}, _, _, _) } mkUnique -> case sheetType of
+  (\DBRow{ dbrOutput=(Entity subId _, _, _, _, _, _) } -> return subId)
+  (\DBRow{ dbrOutput=(Entity _ Submission{..}, Entity _ Sheet{..}, _, _, _, _) } mkUnique -> case sheetType of
       NotGraded -> over (_1.mapped) (_2 .~) <$> pure (FormSuccess Nothing, mempty)
       _other -> over (_1.mapped) (_2 .~) . over _2 fvInput <$> mopt pointsField (fsUniq mkUnique "points") (Just submissionRatingPoints)
   )
 
 colCommentField :: Colonnade Sortable CorrectionTableData (DBCell _ (FormResult (DBFormResult SubmissionId (a, b, Maybe Text) CorrectionTableData)))
 colCommentField = sortable (Just "comment") (i18nCell MsgRatingComment) $ formCell id
-  (\DBRow{ dbrOutput=(Entity subId _, _, _, _, _) } -> return subId)
-  (\DBRow{ dbrOutput=(Entity _ Submission{..}, _, _, _, _) } mkUnique -> over (_1.mapped) ((_3 .~) . assertM (not . null) . fmap (Text.strip . unTextarea)) . over _2 fvInput <$> mopt textareaField (fsUniq mkUnique "comment") (Just $ Textarea <$> submissionRatingComment))
+  (\DBRow{ dbrOutput=(Entity subId _, _, _, _, _, _) } -> return subId)
+  (\DBRow{ dbrOutput=(Entity _ Submission{..}, _, _, _, _, _) } mkUnique -> over (_1.mapped) ((_3 .~) . assertM (not . null) . fmap (Text.strip . unTextarea)) . over _2 fvInput <$> mopt textareaField (fsUniq mkUnique "comment") (Just $ Textarea <$> submissionRatingComment))
+
+colLastEdit :: IsDBTable m a => Colonnade Sortable CorrectionTableData (DBCell m a)
+colLastEdit = sortable (Just "last-edit") (i18nCell MsgLastEdit) $
+   \DBRow{ dbrOutput=(_, _, _, _, mbLastEdit, _) } -> maybe mempty dateTimeCell mbLastEdit
 
 
 makeCorrectionsTable :: ( IsDBTable m x, ToSortable h, Functor h )
@@ -212,10 +224,10 @@ makeCorrectionsTable whereClause dbtColonnade dbtFilterUI psValidator dbtProj' d
                         , course E.^. CourseTerm
                         , course E.^. CourseSchool    :: E.SqlExpr (E.Value SchoolId)
                         )
-            in (submission, sheet, crse, corrector)
+            in (submission, sheet, crse, corrector, lastEditQuery submission)
           )
       dbtProj :: DBRow _ -> MaybeT (ReaderT SqlBackend (HandlerT UniWorX IO)) CorrectionTableData
-      dbtProj = traverse $ \(submission@(Entity sId _), sheet@(Entity shId _), (E.Value courseName, E.Value courseShorthand, E.Value courseTerm, E.Value courseSchool), mCorrector) -> do
+      dbtProj = traverse $ \(submission@(Entity sId _), sheet@(Entity shId _), (E.Value courseName, E.Value courseShorthand, E.Value courseTerm, E.Value courseSchool), mCorrector,  E.Value mbLastEdit) -> do
         submittors <- lift . E.select . E.from $ \((submissionUser `E.InnerJoin` user) `E.LeftOuterJoin` pseudonym) -> do
           E.on $ pseudonym E.?. SheetPseudonymUser E.==. E.just (user E.^. UserId)
            E.&&. pseudonym E.?. SheetPseudonymSheet E.==. E.just (E.val shId)
@@ -225,7 +237,7 @@ makeCorrectionsTable whereClause dbtColonnade dbtFilterUI psValidator dbtProj' d
           return (user, pseudonym E.?. SheetPseudonymPseudonym)
         let
           submittorMap = foldr (\(Entity userId user, E.Value pseudo) -> Map.insert userId (user, pseudo)) Map.empty submittors
-        dbtProj' (submission, sheet, (courseName, courseShorthand, courseTerm, courseSchool), mCorrector, submittorMap)
+        dbtProj' (submission, sheet, (courseName, courseShorthand, courseTerm, courseSchool), mCorrector, mbLastEdit, submittorMap)
   dbTable psValidator DBTable
     { dbtSQLQuery
     , dbtRowKey = \((_ `E.InnerJoin` _ `E.InnerJoin` submission) `E.LeftOuterJoin` _ :: CorrectionTableExpr) -> submission E.^. SubmissionId
@@ -271,6 +283,9 @@ makeCorrectionsTable whereClause dbtColonnade dbtFilterUI psValidator dbtProj' d
       , ( "comment" -- sorting by comment specifically requested by correctors to easily see submissions to be done
         , SortColumn $ \((_ `E.InnerJoin` _ `E.InnerJoin` submission) `E.LeftOuterJoin` _) -> submission E.^. SubmissionRatingComment
         )
+      , ( "last-edit"
+        , SortColumn $ \((_course `E.InnerJoin` _sheet `E.InnerJoin` submission) `E.LeftOuterJoin` _corrector) -> lastEditQuery submission
+        )
       ]
     , dbtFilter    = Map.fromList
       [ ( "term"
@@ -417,7 +432,18 @@ correctionsR whereClause displayColumns dbtFilterUI psValidator actions = do
       redirect currentRoute
     FormSuccess (CorrAutoSetCorrectorData shid, subs') -> do
       subs <- mapM decrypt $ Set.toList subs'
-      runDB $ do
+      let
+        assignExceptions :: AssignSubmissionException -> Handler ()
+        assignExceptions NoCorrectors = addMessageI Error MsgAssignSubmissionExceptionNoCorrectors
+        assignExceptions NoCorrectorsByProportion = addMessageI Error MsgAssignSubmissionExceptionNoCorrectorsByProportion
+        assignExceptions (SubmissionsNotFound subIds) = do
+          subCIDs <- mapM encrypt . Set.toList $ toNullable subIds :: Handler [CryptoFileNameSubmission]
+          let errorModal = msgModal
+                [whamlet|_{MsgAssignSubmissionExceptionSubmissionsNotFound (length subCIDs)}|]
+                (Right $(widgetFile "messages/submissionsAssignNotFound"))
+          addMessageWidget Error errorModal
+                
+      handle assignExceptions . runDB $ do
         alreadyAssigned <- selectList [SubmissionId <-. subs, SubmissionRatingBy !=. Nothing] []
         unless (null alreadyAssigned) $ do
           mr <- (toHtml . ) <$> getMessageRender
@@ -502,7 +528,7 @@ postCorrectionsR = do
   let whereClause = ratedBy uid
       colonnade = mconcat
         [ colSelect
-        , dbRow
+        , dbRow     -- very useful, since correction statistics are still missing.
         , colSchool
         , colTerm
         , colCourse
@@ -531,7 +557,7 @@ postCorrectionsR = do
         optionsPairs $ map (id &&& id) $ nub $ map (CI.original . unSchoolKey . courseSchool . entityVal) courses
 
       psValidator = def
-        & restrictFilter (\name _ -> name /= "corrector") -- We need to be careful to restrict allowed sorting/filter to not expose sensitive information
+        & restrictFilter  (\name _ -> name /= "corrector") -- We need to be careful to restrict allowed sorting/filter to not expose sensitive information
         & restrictSorting (\name _ -> name /= "corrector")
         & defaultSorting [SortAscBy "israted", SortDescBy "ratingTime", SortAscBy "assignedtime" ]
         -- & defaultFilter (Map.fromList [("israted",[toPathPiece False])]) -- DEPENDS ON ISSUE #371 UNCOMMENT THEN
@@ -551,6 +577,7 @@ postCCorrectionsR tid ssh csh = do
         , colSMatrikel
         , colSubmittors
         , colSubmissionLink
+        , colLastEdit
         , colRating
         , colRated
         , colCorrector
@@ -574,6 +601,7 @@ postSSubsR tid ssh csh shn = do
         , colSMatrikel
         , colSubmittors
         , colSubmissionLink
+        , colLastEdit
         , colRating
         , colRated
         , colCorrector
@@ -627,7 +655,7 @@ postCorrectionR tid ssh csh shn cid = do
             }
 
       ((uploadResult, uploadForm'), uploadEncoding) <- runFormPost . identifyForm FIDcorrectionUpload . renderAForm FormStandard $
-            areq (zipFileField True) (fslI MsgRatingFiles) Nothing
+            areq (zipFileField True Nothing) (fslI MsgRatingFiles) Nothing
       let uploadForm = wrapForm uploadForm' def
             { formAction = Just . SomeRoute $ CSubmissionR tid ssh csh shn cid CorrectionR
             , formEncoding = uploadEncoding
@@ -703,7 +731,7 @@ getCorrectionsUploadR, postCorrectionsUploadR :: Handler Html
 getCorrectionsUploadR = postCorrectionsUploadR
 postCorrectionsUploadR = do
   ((uploadRes, upload), uploadEncoding) <- runFormPost . identifyForm FIDcorrectionsUpload . renderAForm FormStandard $
-       areq (zipFileField True) (fslI MsgCorrUploadField & addAttr "uw-file-input" "") Nothing
+       areq (zipFileField True Nothing) (fslI MsgCorrUploadField) Nothing
 
   case uploadRes of
     FormMissing -> return ()
@@ -897,8 +925,8 @@ postCorrectionsGradeR = do
         ] -- Continue here
       psValidator = def
         & defaultSorting [SortDescBy "ratingtime"] :: PSValidator (MForm (HandlerT UniWorX IO)) (FormResult (DBFormResult SubmissionId (Bool, Maybe Points, Maybe Text) CorrectionTableData))
-      unFormResult = getDBFormResult $ \DBRow{ dbrOutput = (Entity _ sub@Submission{..}, _, _, _, _) } -> (submissionRatingDone sub, submissionRatingPoints, submissionRatingComment)
-      dbtProj' i@(Entity subId _, Entity _ Sheet{ sheetName = shn }, (_, csh, tid, ssh), _, _) = do
+      unFormResult = getDBFormResult $ \DBRow{ dbrOutput = (Entity _ sub@Submission{..}, _, _, _, _, _) } -> (submissionRatingDone sub, submissionRatingPoints, submissionRatingComment)
+      dbtProj' i@(Entity subId _, Entity _ Sheet{ sheetName = shn }, (_, csh, tid, ssh), _, _, _) = do
         cID <- encrypt subId
         void . assertM (== Authorized) . lift $ evalAccessDB (CSubmissionR tid ssh csh shn cID CorrectionR) True
         return i
diff --git a/src/Handler/Course.hs b/src/Handler/Course.hs
index a274dbd92..5abd1e624 100644
--- a/src/Handler/Course.hs
+++ b/src/Handler/Course.hs
@@ -11,7 +11,6 @@ import Handler.Utils
 import Handler.Utils.Course
 import Handler.Utils.Tutorial
 import Handler.Utils.Communication
-import Handler.Utils.Form.MassInput
 import Handler.Utils.Delete
 import Handler.Utils.Database
 import Handler.Utils.Table.Cells
diff --git a/src/Handler/Health.hs b/src/Handler/Health.hs
index 872ab3410..046c16aff 100644
--- a/src/Handler/Health.hs
+++ b/src/Handler/Health.hs
@@ -9,55 +9,71 @@ import Utils.Lens
 
 import qualified Data.UUID as UUID
 
+import Data.Semigroup (Min(..), Max(..))
+
+import qualified Data.Set as Set
+
+import Control.Concurrent.STM.Delay
+
 
 getHealthR :: Handler TypedContent
 getHealthR = do
-  healthReport' <- liftIO . readTVarIO =<< getsYesod appHealthReport
-  let
-    handleMissing = do
-      interval <- getsYesod $ round . (* 1e6) . toRational . view _appHealthCheckInterval
-      reportStore <- getsYesod appHealthReport
-      waitResult <- threadDelay interval `race` atomically (readTVar reportStore >>= guard . is _Just)
-      case waitResult of
-        Left () -> fail "System is not generating HealthReports"
-        Right _ -> redirect HealthR
-  (lastUpdated, healthReport) <- maybe handleMissing return healthReport'
+  reportStore <- getsYesod appHealthReport
+  healthReports' <- liftIO $ readTVarIO reportStore
   interval <- getsYesod $ view _appHealthCheckInterval
-  instanceId <- getsYesod appInstanceID
 
-  setWeakEtagHashable (instanceId, lastUpdated)
-  expiresAt $ interval `addUTCTime` lastUpdated
-  setLastModified lastUpdated
-  
-  let status 
-        | HealthSuccess <- classifyHealthReport healthReport
-        = ok200
-        | otherwise
-        = internalServerError500
-  sendResponseStatus status <=< selectRep $ do
-    provideRep . siteLayoutMsg MsgHealthReport $ do
-      setTitleI MsgHealthReport
-      let HealthReport{..} = healthReport
-      [whamlet|
-        $newline never
-        

-          
_{MsgHealthMatchingClusterConfig}
-          
#{boolSymbol healthMatchingClusterConfig}
-          $maybe httpReachable <- healthHTTPReachable
-            
_{MsgHealthHTTPReachable}
-            
#{boolSymbol httpReachable}
-          $maybe ldapAdmins <- healthLDAPAdmins
-            
_{MsgHealthLDAPAdmins}
-            
#{textPercent ldapAdmins}
-          $maybe smtpConnect <- healthSMTPConnect
-            
_{MsgHealthSMTPConnect}
-            
#{boolSymbol smtpConnect}
-          $maybe widgetMemcached <- healthWidgetMemcached
-            
_{MsgHealthWidgetMemcached}
-            
#{boolSymbol widgetMemcached}
-      |]
-    provideJson healthReport
-    provideRep . return . Builder.toLazyText $ Aeson.encodePrettyToTextBuilder healthReport
+  case fromNullable healthReports' of
+    Nothing -> do
+      let Min (NTop minInterval) = ofoldMap1 (Min . NTop) $ impureNonNull interval
+      delay <- for minInterval $ \minInterval' -> liftIO . newDelay . round $ toRational minInterval' * 1e6
+      waitResult <- atomically $ maybe (pure $ Left False) (fmap (const $ Left True) . waitDelay) delay <|> (fmap Right . assertM (not. Set.null) $ readTVar reportStore)
+      case waitResult of
+        Left False -> sendResponseStatus noContent204 ()
+        Left True  -> fail "System is not generating HealthReports"
+        Right _    -> redirect HealthR
+    Just healthReports -> do
+      let (Max lastUpdated, Min status) = ofoldMap1 (Max *** Min . healthReportStatus) healthReports
+          reportNextUpdate (lastCheck, classifyHealthReport -> kind)
+            = fromMaybe 0 (interval kind) `addUTCTime` lastCheck
+          Max nextUpdate = ofoldMap1 (Max . reportNextUpdate) healthReports
+      instanceId <- getsYesod appInstanceID
+
+      setWeakEtagHashable (instanceId, lastUpdated)
+      expiresAt nextUpdate
+      setLastModified lastUpdated
+
+      let status'
+            | HealthSuccess <- status
+            = ok200
+            | otherwise
+            = internalServerError500
+      sendResponseStatus status' <=< selectRep $ do
+        provideRep . siteLayoutMsg MsgHealthReport $ do
+          setTitleI MsgHealthReport
+          [whamlet|
+            $newline never
+            

+              $forall (_, report) <- healthReports'
+                $case report
+                  $of HealthMatchingClusterConfig passed
+                    
_{MsgHealthMatchingClusterConfig}
+                    
#{boolSymbol passed}
+                  $of HealthHTTPReachable (Just passed)
+                    
_{MsgHealthHTTPReachable}
+                    
#{boolSymbol passed}
+                  $of HealthLDAPAdmins (Just found)
+                    
_{MsgHealthLDAPAdmins}
+                    
#{textPercent found}
+                  $of HealthSMTPConnect (Just passed)
+                    
_{MsgHealthSMTPConnect}
+                    
#{boolSymbol passed}
+                  $of HealthWidgetMemcached (Just passed)
+                    
_{MsgHealthWidgetMemcached}
+                    
#{boolSymbol passed}
+                  $of _
+          |]
+        provideJson healthReports
+        provideRep . return . Builder.toLazyText $ Aeson.encodePrettyToTextBuilder healthReports
 
 getInstanceR :: Handler TypedContent
 getInstanceR = do
diff --git a/src/Handler/Material.hs b/src/Handler/Material.hs
index 7ae50af56..119fa5027 100644
--- a/src/Handler/Material.hs
+++ b/src/Handler/Material.hs
@@ -9,7 +9,7 @@ import qualified Data.Set as Set
 import qualified Data.Map as Map
 import qualified Data.Conduit.List as C
 -- import qualified Data.CaseInsensitive as CI
-import qualified Data.Text.Encoding as Text
+-- import qualified Data.Text.Encoding as Text
 
 import qualified Database.Esqueleto as E
 import Database.Esqueleto.Utils.TH
@@ -107,15 +107,18 @@ getMaterialListR tid ssh csh = do
   seeAllModificationTimestamps <- hasWriteAccessTo $ CourseR tid ssh csh MaterialNewR -- ordinary users should not see modification dates older than visibility
   table <- runDB $ do
     cid <- getKeyBy404 $ TermSchoolCourseShort tid ssh csh
-    let row2material = entityVal . dbrOutput -- no inner join, just Entity Material
+    let row2material = view $ _dbrOutput . _1 . _entityVal
         psValidator  = def & defaultSorting [SortDescBy "last-edit"]
     dbTableWidget' psValidator DBTable
       { dbtIdent     = "material-list" :: Text
       , dbtStyle     = def
       , dbtParams    = def
       , dbtSQLQuery  = \material -> do
-            E.where_ $ material E.^. MaterialCourse  E.==.  E.val cid
-            return material
+          E.where_ $ material E.^. MaterialCourse  E.==.  E.val cid
+          let filesNum = E.sub_select . E.from $ \materialFile -> do
+                E.where_ $ materialFile E.^. MaterialFileMaterial E.==. material E.^. MaterialId
+                return E.countRows :: E.SqlQuery (E.SqlExpr (E.Value Int64))
+          return (material, filesNum)
       , dbtRowKey    = (E.^. MaterialId)
       -- , dbtProj      = \dbr -> guardAuthorizedFor (matLink . materialName $ dbr ^. _dbrOutput . _entityVal) dbr
       , dbtProj      = guardAuthorizedFor =<< matLink . materialName . row2material -- Moand: (a ->)
@@ -127,8 +130,10 @@ getMaterialListR tid ssh csh = do
                 $ liftA2 anchorCell matLink toWgt . materialName . row2material
             , sortable (toNothingS "description") mempty
                 $ foldMap modalCell . materialDescription . row2material
-            , sortable (toNothingS "zip-archive") mempty -- TODO: don't show if there are no files!
-                $ fileCell . filesLink . materialName . row2material
+            , sortable (toNothingS "zip-archive") mempty
+                $ \DBRow{ dbrOutput = (Entity _ Material{..}, E.Value fileNum) } -> if
+                  | fileNum == 0 -> mempty
+                  | otherwise    -> fileCell $ filesLink materialName
             , sortable (Just "visible-from") (i18nCell MsgAccessibleSince)
                 $ foldMap (dateTimeCellVisible now) . materialVisibleFrom . row2material
             , sortable (Just "last-edit") (i18nCell MsgFileModified)
@@ -156,9 +161,9 @@ getMaterialListR tid ssh csh = do
 
 
 getMFileR :: TermId -> SchoolId -> CourseShorthand -> MaterialName -> FilePath -> Handler TypedContent
-getMFileR tid ssh csh mnm title = serveOneFile fileQuery
+getMFileR tid ssh csh mnm title = serveOneFile $ fileQuery .| C.map entityVal
   where
-    fileQuery = E.select $ E.from $
+    fileQuery = E.selectSource $ E.from $
       \(course `E.InnerJoin` material `E.InnerJoin` matFile `E.InnerJoin` file) -> do
         -- Restrict to consistent rows that correspond to each other
         E.on (file     E.^. FileId               E.==. matFile  E.^. MaterialFileFile)
@@ -180,7 +185,7 @@ getMShowR tid ssh csh mnm = do
       matLink = CourseR tid ssh csh . MaterialR mnm . MFileR
 
       zipLink :: Route UniWorX
-      zipLink = CMaterialR tid ssh csh mnm MZipR
+      zipLink = CMaterialR tid ssh csh mnm MArchiveR
 
   seeAllModificationTimestamps <- hasReadAccessTo $ CourseR tid ssh csh CNotesR -- ordinary users should not see modification dates older than visibility
 
@@ -351,28 +356,12 @@ postMDelR tid ssh csh mnm = do
     , drAbort   = SomeRoute $ CourseR tid ssh csh $ MaterialR mnm MShowR
     }
 
--- | Variant of getMArchiveR that always serves a Zip Archive, even for single files. Kept, since we might change this according to UX feedback.
-getMZipR :: TermId -> SchoolId -> CourseShorthand -> MaterialName -> Handler TypedContent
-getMZipR tid ssh csh mnm = do
-  let filename = ZIPArchiveName mnm
-  addHeader "Content-Disposition" [st|attachment; filename="#{toPathPiece filename}"|]
-  respondSourceDB "application/zip" $ do
-    mid <- lift $ getMaterialKeyBy404 tid ssh csh mnm
-    -- Entity{entityKey=mid, entityVal=material} <- lift $ fetchMaterial tid ssh csh mnm
-    let
-      fileSelect = E.selectSource . E.from $ \(materialFile `E.InnerJoin` file) -> do
-        E.on     $  materialFile E.^. MaterialFileFile E.==. file E.^. FileId
-        E.where_ $  materialFile E.^. MaterialFileMaterial E.==. E.val mid
-        return file
-      zipComment = Text.encodeUtf8 $ termToText (unTermKey tid) <> "-" <> toPathPiece (unSchoolKey ssh <> "-" <> csh <> ":" <> mnm)
-    fileSelect .| C.map entityVal .| produceZip ZipInfo{..} .| C.map toFlushBuilder
-
--- | Variant of getMZipR that does not serve single file Zip Archives. Maybe confusing to users.
+-- | Serve all material-files
 getMArchiveR :: TermId -> SchoolId -> CourseShorthand -> MaterialName -> Handler TypedContent
 getMArchiveR tid ssh csh mnm = serveSomeFiles archivename getMatQuery
   where
-    archivename = termToText (unTermKey tid) <> "-" <> toPathPiece (unSchoolKey ssh <> "-" <> csh <> "-" <> mnm)
-    getMatQuery = E.select . E.from $
+    archivename = unpack (termToText (unTermKey tid) <> "-" <> toPathPiece (unSchoolKey ssh <> "-" <> csh <> "-" <> mnm)) <.> "zip"
+    getMatQuery = (.| C.map entityVal) . E.selectSource . E.from $
       \(course `E.InnerJoin` material `E.InnerJoin` materialFile `E.InnerJoin` file) -> do
         E.on $ file     E.^. FileId         E.==. materialFile E.^. MaterialFileFile
         E.on $ material E.^. MaterialId     E.==. materialFile E.^. MaterialFileMaterial
diff --git a/src/Handler/Sheet.hs b/src/Handler/Sheet.hs
index 0a3b8c3fe..f315c7709 100644
--- a/src/Handler/Sheet.hs
+++ b/src/Handler/Sheet.hs
@@ -14,7 +14,6 @@ import Handler.Utils.Table.Cells
 -- import Handler.Utils.Table.Columns
 import Handler.Utils.SheetType
 import Handler.Utils.Delete
-import Handler.Utils.Form.MassInput
 import Handler.Utils.Invitations
 
 -- import Data.Time
@@ -69,19 +68,19 @@ import Text.Hamlet (ihamlet)
 
 data SheetForm = SheetForm
       { sfName         :: SheetName
-      , sfDescription  :: Maybe Html
-      , sfType         :: SheetType
-      , sfGrouping     :: SheetGroup
       , sfVisibleFrom  :: Maybe UTCTime
       , sfActiveFrom   :: UTCTime
       , sfActiveTo     :: UTCTime
-      , sfSubmissionMode :: SubmissionMode
-      , sfSheetF       :: Maybe (Source Handler (Either FileId File))
       , sfHintFrom     :: Maybe UTCTime
-      , sfHintF        :: Maybe (Source Handler (Either FileId File))
       , sfSolutionFrom :: Maybe UTCTime
+      , sfSheetF       :: Maybe (Source Handler (Either FileId File))
+      , sfHintF        :: Maybe (Source Handler (Either FileId File))
       , sfSolutionF    :: Maybe (Source Handler (Either FileId File))
       , sfMarkingF     :: Maybe (Source Handler (Either FileId File))
+      , sfType         :: SheetType
+      , sfGrouping     :: SheetGroup
+      , sfSubmissionMode :: SubmissionMode
+      , sfDescription  :: Maybe Html
       , sfMarkingText  :: Maybe Html
       -- Keine SheetId im Formular!
       }
@@ -103,12 +102,7 @@ makeSheetForm msId template = identifyForm FIDsheet $ \html -> do
     ctime <- ceilingQuarterHour <$> liftIO getCurrentTime
     (result, widget) <- flip (renderAForm FormStandard) html $ SheetForm
       <$> areq ciField        (fslI MsgSheetName)         (sfName        <$> template)
-      <*> aopt htmlField      (fslpI MsgSheetDescription "Html")
-                                                          (sfDescription <$> template)
-      <*> sheetTypeAFormReq   (fslI MsgSheetType
-            & setTooltip (uniworxMessages [MsgSheetTypeInfoBonus,MsgSheetTypeInfoNotGraded]))
-                                                          (sfType        <$> template)
-      <*> sheetGroupAFormReq  (fslI MsgSheetGroup)        (sfGrouping    <$> template)
+      <* aformSection MsgSheetFormTimes
       <*> aopt utcTimeField   (fslI MsgSheetVisibleFrom
             & setTooltip MsgSheetVisibleFromTip)
                                                               ((sfVisibleFrom  <$> template) <|> pure (Just ctime))
@@ -116,17 +110,24 @@ makeSheetForm msId template = identifyForm FIDsheet $ \html -> do
             & setTooltip MsgSheetActiveFromTip)
                                                               (sfActiveFrom   <$> template)
       <*> areq utcTimeField   (fslI MsgSheetActiveTo)         (sfActiveTo     <$> template)
-      <*> submissionModeForm ((sfSubmissionMode <$> template) <|> pure (SubmissionMode False . Just $ Upload True))
-      <*> aopt (multiFileField $ oldFileIds SheetExercise) (fslI MsgSheetExercise) (sfSheetF <$> template)
       <*> aopt utcTimeField   (fslpI MsgSheetHintFrom "Datum, sonst nur für Korrektoren"
             & setTooltip MsgSheetHintFromTip)                 (sfHintFrom     <$> template)
-      <*> aopt (multiFileField $ oldFileIds SheetHint)     (fslI MsgSheetHint)      (sfHintF <$> template)
       <*> aopt utcTimeField   (fslpI MsgSheetSolutionFrom  "Datum, sonst nur für Korrektoren"
-            & setTooltip MsgSheetSolutionFromTip)
-                                                              (sfSolutionFrom <$> template)
+            & setTooltip MsgSheetSolutionFromTip)             (sfSolutionFrom <$> template)
+      <* aformSection MsgSheetFormFiles
+      <*> aopt (multiFileField $ oldFileIds SheetExercise) (fslI MsgSheetExercise) (sfSheetF <$> template)
+      <*> aopt (multiFileField $ oldFileIds SheetHint)     (fslI MsgSheetHint)      (sfHintF <$> template)
       <*> aopt (multiFileField $ oldFileIds SheetSolution) (fslI MsgSheetSolution) (sfSolutionF <$> template)
-      <*> aopt (multiFileField $ oldFileIds SheetMarking)  (fslI MsgSheetMarking
-            & setTooltip MsgSheetMarkingTip)   (sfMarkingF <$> template)
+      <*> aopt (multiFileField $ oldFileIds SheetMarking)  (fslI MsgSheetMarkingFiles
+            & setTooltip MsgSheetMarkingTip)                  (sfMarkingF <$> template)
+      <* aformSection MsgSheetFormType
+      <*> sheetTypeAFormReq   (fslI MsgSheetType
+            & setTooltip (uniworxMessages [MsgSheetTypeInfoBonus,MsgSheetTypeInfoNotGraded]))
+                                                          (sfType        <$> template)
+      <*> sheetGroupAFormReq  (fslI MsgSheetGroup)        (sfGrouping    <$> template)
+      <*> submissionModeForm ((sfSubmissionMode <$> template) <|> pure (SubmissionMode False . Just $ UploadAny True defaultExtensionRestriction))
+      <*> aopt htmlField      (fslpI MsgSheetDescription "Html")
+                                                          (sfDescription <$> template)
       <*> aopt htmlField    (fslpI MsgSheetMarking "Html") (sfMarkingText <$> template)
     return $ case result of
       FormSuccess sheetResult
@@ -146,16 +147,33 @@ makeSheetForm msId template = identifyForm FIDsheet $ \html -> do
 
 
 getSheetCurrentR :: TermId -> SchoolId -> CourseShorthand -> Handler Html
-getSheetCurrentR tid ssh csh = runDB $ do
-  let redi shn = redirectAccess $ CSheetR tid ssh csh shn SShowR
-  shn <- sheetCurrent tid ssh csh
-  maybe notFound redi shn
+getSheetCurrentR tid ssh csh = do
+  mbShn <- runDB $ sheetCurrent tid ssh csh
+  case mbShn of
+    Just shn -> redirectAccess $ CSheetR tid ssh csh shn SShowR
+    Nothing  -> do -- no current sheet exists
+      -- users should never see a link to this URL in this situation,
+      -- but we had confused users that used a bookmark instead.
+      let headingShort = [whamlet|_{MsgMenuSheetCurrent}|]
+          headingLong = prependCourseTitle tid ssh csh MsgMenuSheetCurrent
+      siteLayout headingShort $ do
+        setTitleI headingLong
+        [whamlet|_{MsgSheetNoCurrent}|]
 
-getSheetOldUnassigned :: TermId -> SchoolId -> CourseShorthand -> Handler ()
-getSheetOldUnassigned tid ssh csh = runDB $ do
-  let redi shn = redirectAccess $ CSheetR tid ssh csh shn SSubsR
-  shn <- sheetOldUnassigned tid ssh csh
-  maybe notFound redi shn
+
+getSheetOldUnassignedR:: TermId -> SchoolId -> CourseShorthand -> Handler Html
+getSheetOldUnassignedR tid ssh csh = do
+    mbShn <- runDB $ sheetOldUnassigned tid ssh csh
+    case mbShn of
+      Just shn -> redirectAccess $ CSheetR tid ssh csh shn SSubsR
+      Nothing  -> do -- no unassigned submissions in any inactive sheet
+        -- users should never see a link to this URL in this situation,
+        -- but we had confused users that used a bookmark instead.
+        let headingShort = [whamlet|_{MsgMenuSheetOldUnassigned}|]
+            headingLong = prependCourseTitle tid ssh csh MsgMenuSheetOldUnassigned
+        siteLayout headingShort $ do
+          setTitleI headingLong
+          [whamlet|_{MsgSheetNoOldUnassigned}|]
 
 getSheetListR :: TermId -> SchoolId -> CourseShorthand -> Handler Html
 getSheetListR tid ssh csh = do
@@ -194,16 +212,16 @@ getSheetListR tid ssh csh = do
       , sortable (Just "visible-from") (i18nCell MsgAccessibleSince)
           $ \DBRow{dbrOutput=(Entity _ Sheet{..}, _, _, _)} -> foldMap (dateTimeCellVisible now) sheetVisibleFrom
       , sortable (toNothing "downloads") (i18nCell MsgFiles)
-          $ \DBRow{dbrOutput=(Entity _ Sheet{..}, _, _, existFiles)} -> mconcat
+          $ \DBRow{dbrOutput=(Entity _ Sheet{..}, _, _, existFiles)} -> listCell
               [ icnCell & addIconFixedWidth
               | let existingSFTs = hasSFT existFiles
               , sft <- [minBound..maxBound]
-              , let link = CSheetR tid ssh csh sheetName $ SZipR $ ZIPArchiveName sft
+              , let link = CSheetR tid ssh csh sheetName $ SZipR sft
               , let icn  = toWidget $ sheetFile2markup sft
               , let icnCell = if sft `elem` existingSFTs
                               then linkEmptyCell link icn
                               else spacerCell
-              ]
+              ] id & cellAttrs <>~ [("class","list--inline list--space-separated")]
       , sortable (Just "submission-since") (i18nCell MsgSheetActiveFrom)
           $ \DBRow{dbrOutput=(Entity _ Sheet{..}, _, _, _)} -> dateTimeCell sheetActiveFrom
       , sortable (Just "submission-until") (i18nCell MsgSheetActiveTo)
@@ -438,11 +456,11 @@ postSPseudonymR tid ssh csh shn = do
 
 
 getSFileR :: TermId -> SchoolId -> CourseShorthand -> SheetName -> SheetFileType -> FilePath -> Handler TypedContent
-getSFileR tid ssh csh shn sft file = serveOneFile $ sheetFileQuery tid ssh csh shn sft file
+getSFileR tid ssh csh shn sft file = serveOneFile $ sheetFileQuery tid ssh csh shn sft file .| C.map entityVal
 
-getSZipR :: TermId -> SchoolId -> CourseShorthand -> SheetName -> ZIPArchiveName SheetFileType -> Handler TypedContent
-getSZipR tid ssh csh shn filename@(ZIPArchiveName sft)
-  = serveSomeFiles (toPathPiece filename) $ sheetFilesAllQuery tid ssh csh shn sft
+getSZipR :: TermId -> SchoolId -> CourseShorthand -> SheetName -> SheetFileType -> Handler TypedContent
+getSZipR tid ssh csh shn sft
+  = serveSomeFiles (unpack (toPathPiece sft) <.> "zip") $ sheetFilesAllQuery tid ssh csh shn sft .| C.map entityVal
 
 
 getSheetNewR :: TermId -> SchoolId -> CourseShorthand -> Handler Html
diff --git a/src/Handler/Submission.hs b/src/Handler/Submission.hs
index bdad11b37..12c605917 100644
--- a/src/Handler/Submission.hs
+++ b/src/Handler/Submission.hs
@@ -14,7 +14,6 @@ import Handler.Utils
 import Handler.Utils.Delete
 import Handler.Utils.Submission
 import Handler.Utils.Table.Cells
-import Handler.Utils.Form.MassInput
 import Handler.Utils.Invitations
 
 -- import Control.Monad.Trans.Maybe
@@ -38,8 +37,6 @@ import Data.Map (Map, (!), (!?))
 import qualified Data.Map as Map
 -- import Data.Bifunctor
 
-import System.FilePath
-
 import Text.Blaze (Markup)
 import Data.Aeson hiding (Result(..))
 import Text.Hamlet (ihamlet)
@@ -132,8 +129,19 @@ makeSubmissionForm cid msmid uploadMode grouping isLecturer prefillUsers = ident
     fileUploadForm = case uploadMode of
       NoUpload
         -> pure Nothing
-      (Upload unpackZips)
-        -> (bool (\f fs _ -> Just <$> areq f fs Nothing) aopt $ isJust msmid) (zipFileField unpackZips) (fsm $ bool MsgSubmissionFile MsgSubmissionArchive unpackZips) Nothing
+      UploadAny{..}
+        -> (bool (\f fs _ -> Just <$> areq f fs Nothing) aopt $ isJust msmid) (zipFileField unpackZips extensionRestriction) (fsm $ bool MsgSubmissionFile MsgSubmissionArchive unpackZips) Nothing
+      UploadSpecific{..}
+        -> mergeFileSources <$> sequenceA (map specificFileForm . Set.toList $ toNullable specificFiles)
+
+    specificFileForm :: UploadSpecificFile -> AForm Handler (Maybe (Source Handler File))
+    specificFileForm spec@UploadSpecificFile{..}
+      = bool (\f fs d -> aopt f fs $ fmap Just d) (\f fs d -> Just <$> areq f fs d) specificFileRequired (specificFileField spec) (fsl specificFileLabel) Nothing
+
+    mergeFileSources :: [Maybe (Source Handler File)] -> Maybe (Source Handler File)
+    mergeFileSources (catMaybes -> sources) = case sources of
+      [] -> Nothing
+      fs -> Just $ sequence_ fs
 
     miCell' :: Markup -> Either UserEmail UserId -> Widget
     miCell' csrf (Left email) = $(widgetFile "widgets/massinput/submissionUsers/cellInvitation")
@@ -354,7 +362,9 @@ submissionHelper tid ssh csh shn mcid = do
               return (userName, submissionEdit E.^. SubmissionEditTime)
             forM raw $ \(E.Value name, E.Value time) -> (name, ) <$> formatTime SelFormatDateTime time
         return (csheet,buddies,lastEdits,maySubmit,isLecturer,isOwner)
-  ((res,formWidget'), formEnctype) <- runFormPost . makeSubmissionForm sheetCourse msmid (fromMaybe (Upload True) . submissionModeUser $ sheetSubmissionMode) sheetGrouping isLecturer $ bool id (Set.insert $ Right uid) isOwner buddies
+  -- @submissionModeUser == Nothing@ below iff we are currently serving a user with elevated rights (lecturer, admin, ...)
+  -- Therefore we do not restrict upload behaviour in any way in that case
+  ((res,formWidget'), formEnctype) <- runFormPost . makeSubmissionForm sheetCourse msmid (fromMaybe (UploadAny True Nothing) . submissionModeUser $ sheetSubmissionMode) sheetGrouping isLecturer $ bool id (Set.insert $ Right uid) isOwner buddies 
   let formWidget = wrapForm' BtnHandIn formWidget' def
         { formAction = Just $ SomeRoute actionUrl
         , formEncoding = formEnctype
@@ -515,8 +525,8 @@ submissionHelper tid ssh csh shn mcid = do
 
   defaultLayout $ do
     setTitleI $ MsgSubmissionEditHead tid ssh csh shn
-    let urlArchive  cID = CSubmissionR tid ssh csh shn cID (SubArchiveR (ZIPArchiveName SubmissionCorrected))
-        urlOriginal cID = CSubmissionR tid ssh csh shn cID (SubArchiveR (ZIPArchiveName SubmissionOriginal))
+    let urlArchive  cID = CSubmissionR tid ssh csh shn cID $ SubArchiveR SubmissionCorrected
+        urlOriginal cID = CSubmissionR tid ssh csh shn cID $ SubArchiveR SubmissionOriginal
     $(widgetFile "submission")
 
 getSInviteR, postSInviteR :: TermId -> SchoolId -> CourseShorthand -> SheetName -> CryptoFileNameSubmission -> Handler Html
@@ -525,72 +535,60 @@ postSInviteR = invitationR submissionUserInvitationConfig
 
 
 getSubDownloadR :: TermId -> SchoolId -> CourseShorthand -> SheetName -> CryptoFileNameSubmission -> SubmissionFileType -> FilePath -> Handler TypedContent
-getSubDownloadR tid ssh csh shn cID (submissionFileTypeIsUpdate -> isUpdate) path = runDB $ do
-  submissionID <- submissionMatchesSheet tid ssh csh shn cID
+getSubDownloadR tid ssh csh shn cID (submissionFileTypeIsUpdate -> isUpdate) path = do
+  (submissionID, isRating) <- runDB $ do
+    submissionID <- submissionMatchesSheet tid ssh csh shn cID
 
-  isRating <- (== Just submissionID) <$> isRatingFile path
+    isRating <- (== Just submissionID) <$> isRatingFile path
 
-  when (isUpdate || isRating) $
-    guardAuthResult =<< evalAccessDB (CSubmissionR tid ssh csh shn cID CorrectionR) False
+    when (isUpdate || isRating) $
+      guardAuthResult =<< evalAccessDB (CSubmissionR tid ssh csh shn cID CorrectionR) False
+
+    return (submissionID, isRating)
 
   case isRating of
     True
-      | isUpdate -> do
+      | isUpdate -> runDB $ do
           file <- runMaybeT $ lift . ratingFile cID =<< MaybeT (getRating submissionID)
           maybe notFound (return . toTypedContent . Text.decodeUtf8) $ fileContent =<< file
       | otherwise -> notFound
     False -> do
-      results <- E.select . E.from $ \(sf `E.InnerJoin` f) -> do
-        E.on (f E.^. FileId E.==. sf E.^. SubmissionFileFile)
-        E.where_ $ sf E.^. SubmissionFileSubmission E.==. E.val submissionID
-             E.&&. f E.^. FileTitle E.==. E.val path
-             E.&&. E.not_ (sf E.^. SubmissionFileIsDeletion)
-             E.&&. sf E.^. SubmissionFileIsUpdate E.==. E.val isUpdate
-             -- E.&&. E.not_ (E.isNothing $ f E.^. FileContent) -- This is fine, we just return 204
-        return f
+      let results = (.| Conduit.map entityVal) . E.selectSource . E.from $ \(sf `E.InnerJoin` f) -> do
+            E.on (f E.^. FileId E.==. sf E.^. SubmissionFileFile)
+            E.where_ $ sf E.^. SubmissionFileSubmission E.==. E.val submissionID
+                 E.&&. f E.^. FileTitle E.==. E.val path
+                 E.&&. E.not_ (sf E.^. SubmissionFileIsDeletion)
+                 E.&&. sf E.^. SubmissionFileIsUpdate E.==. E.val isUpdate
+                 -- E.&&. E.not_ (E.isNothing $ f E.^. FileContent) -- This is fine, we just return 204
+            return f
 
-      case results of
-        [] -> notFound
-        [Entity _ File{ fileContent = Just c, fileTitle }] -> do
-          whenM downloadFiles $
-            addHeader "Content-Disposition" [st|attachment; filename="#{takeFileName fileTitle}"|]
-          return $ TypedContent (mimeLookup (pack fileTitle) <> "; charset=utf-8") (toContent c)
-        [Entity _ File{ fileContent = Nothing }] -> sendResponseStatus noContent204 ()
-        other -> do
-          $logErrorS "SubDownloadR" $ "Multiple matching files: " <> tshow other
-          error "Multiple matching files found."
+      serveOneFile results
 
-getSubArchiveR :: TermId -> SchoolId -> CourseShorthand -> SheetName -> CryptoFileNameSubmission -> ZIPArchiveName SubmissionFileType -> Handler TypedContent
-getSubArchiveR tid ssh csh shn cID (ZIPArchiveName sfType) = do
+getSubArchiveR :: TermId -> SchoolId -> CourseShorthand -> SheetName -> CryptoFileNameSubmission -> SubmissionFileType -> Handler TypedContent
+getSubArchiveR tid ssh csh shn cID sfType = do
   when (sfType == SubmissionCorrected) $
     guardAuthResult =<< evalAccess (CSubmissionR tid ssh csh shn cID CorrectionR) False
 
   let filename
-        | SubmissionOriginal <- sfType = ZIPArchiveName $ toPathPiece cID <> "-" <> toPathPiece sfType
-        | otherwise = ZIPArchiveName $ toPathPiece cID
+        | SubmissionOriginal <- sfType = toPathPiece cID <> "-" <> toPathPiece sfType
+        | otherwise = toPathPiece cID
 
-  addHeader "Content-Disposition" [st|attachment; filename="#{toPathPiece filename}"|]
-  respondSourceDB "application/zip" $ do
-    submissionID <- lift $ submissionMatchesSheet tid ssh csh shn cID
-    rating <- lift $ getRating submissionID
+      source = do
+        submissionID <- lift $ submissionMatchesSheet tid ssh csh shn cID
+        rating <- lift $ getRating submissionID
 
-    let
-      fileSelect = case sfType of
-        SubmissionOriginal -> E.selectSource . E.from $ \(sf `E.InnerJoin` f) -> do
-          E.on $ f E.^. FileId E.==. sf E.^. SubmissionFileFile
-          E.where_ $ sf E.^. SubmissionFileSubmission E.==. E.val submissionID
-               E.&&. sf E.^. SubmissionFileIsUpdate E.==. E.val False
-          return f
-        _ -> submissionFileSource submissionID
+        case sfType of
+          SubmissionOriginal -> (.| Conduit.map entityVal) . E.selectSource . E.from $ \(sf `E.InnerJoin` f) -> do
+            E.on $ f E.^. FileId E.==. sf E.^. SubmissionFileFile
+            E.where_ $ sf E.^. SubmissionFileSubmission E.==. E.val submissionID
+                 E.&&. sf E.^. SubmissionFileIsUpdate E.==. E.val False
+            return f
+          _ -> submissionFileSource submissionID .| Conduit.map entityVal
 
-      fileSource' = do
-        fileSelect .| Conduit.map entityVal
         when (sfType == SubmissionCorrected) $
           maybe (return ()) (yieldM . ratingFile cID) rating
 
-      zipComment = Text.encodeUtf8 $ toPathPiece cID
-
-    fileSource' .| produceZip ZipInfo{..} .| Conduit.map toFlushBuilder
+  serveSomeFiles (unpack filename <.> "zip") source
 
 getSubDelR, postSubDelR :: TermId -> SchoolId -> CourseShorthand -> SheetName -> CryptoFileNameSubmission -> Handler Html
 getSubDelR = postSubDelR
@@ -600,3 +598,16 @@ postSubDelR tid ssh csh shn cID = do
     { drAbort = SomeRoute $ CSubmissionR tid ssh csh shn cID SubShowR
     , drSuccess = SomeRoute $ CSheetR tid ssh csh shn SShowR
     }
+
+
+getCorrectionsDownloadR :: Handler TypedContent
+getCorrectionsDownloadR = do -- download all assigned and open submissions
+  uid <- requireAuthId
+  subs <- runDB $ selectKeysList
+            [ SubmissionRatingBy   ==. Just uid
+            , SubmissionRatingTime ==. Nothing
+            ] []
+  when (null subs) $ do
+    addMessageI Info MsgNoOpenSubmissions
+    redirect CorrectionsR
+  submissionMultiArchive $ Set.fromList subs
diff --git a/src/Handler/Term.hs b/src/Handler/Term.hs
index 08e960581..c25ec43bb 100644
--- a/src/Handler/Term.hs
+++ b/src/Handler/Term.hs
@@ -3,7 +3,6 @@ module Handler.Term where
 import Import
 import Handler.Utils
 import Handler.Utils.Table.Cells
-import Handler.Utils.Form.MassInput
 import qualified Data.Map as Map
 
 import Utils.Lens
diff --git a/src/Handler/Tutorial.hs b/src/Handler/Tutorial.hs
index 534c7d1c1..2a98110c1 100644
--- a/src/Handler/Tutorial.hs
+++ b/src/Handler/Tutorial.hs
@@ -8,7 +8,6 @@ import Handler.Utils.Tutorial
 import Handler.Utils.Table.Cells
 import Handler.Utils.Delete
 import Handler.Utils.Communication
-import Handler.Utils.Form.MassInput
 import Handler.Utils.Form.Occurences
 import Handler.Utils.Invitations
 import Jobs.Queue
diff --git a/src/Handler/Utils.hs b/src/Handler/Utils.hs
index ed2334d5c..e1aea383f 100644
--- a/src/Handler/Utils.hs
+++ b/src/Handler/Utils.hs
@@ -38,6 +38,7 @@ import qualified Data.List as List
 import qualified Data.List.NonEmpty as NonEmpty
 
 
+-- | Check whether the user's preference for files is inline-viewing or downloading
 downloadFiles :: (MonadHandler m, HandlerSite m ~ UniWorX) => m Bool
 downloadFiles = do
   mauth <- liftHandlerT maybeAuth
@@ -47,40 +48,47 @@ downloadFiles = do
       UserDefaultConf{..} <- getsYesod $ view _appUserDefaults
       return userDefaultDownloadFiles
 
+setContentDisposition' :: (MonadHandler m, HandlerSite m ~ UniWorX) => Maybe FilePath -> m ()
+setContentDisposition' mFileName = do
+  wantsDownload <- downloadFiles
+  setContentDisposition (bool ContentInline ContentAttachment wantsDownload) mFileName
+
+-- | Simply send a `File`-Value
+sendThisFile :: File -> Handler TypedContent
+sendThisFile File{..}
+  | Just fileContent' <- fileContent = do
+      setContentDisposition' . Just $ takeFileName fileTitle
+      return $ TypedContent (mimeLookup (pack fileTitle) <> "; charset=utf-8") (toContent fileContent')
+  | otherwise = sendResponseStatus noContent204 ()
+
 -- | Serve a single file, identified through a given DB query
-serveOneFile :: DB [Entity File] -> Handler TypedContent
-serveOneFile query = do
-  results <- runDB query
+serveOneFile :: Source (YesodDB UniWorX) File -> Handler TypedContent
+serveOneFile source = do
+  results <- runDB . runConduit $ source .| Conduit.take 2 -- We don't need more than two files to make a decision below
   case results of
-    [Entity _fileId File{fileTitle, fileContent}]
-      | Just fileContent' <- fileContent -> do
-          whenM downloadFiles $
-            addHeader "Content-Disposition" [st|attachment; filename="#{takeFileName fileTitle}"|]
-          return $ TypedContent (mimeLookup (pack fileTitle) <> "; charset=utf-8") (toContent fileContent')
-      | otherwise -> sendResponseStatus noContent204 ()
-    [] -> notFound
-    other -> do
+    [file] -> sendThisFile file
+    []     -> notFound
+    other  -> do
       $logErrorS "SFileR" $ "Multiple matching files: " <> tshow other
       error "Multiple matching files found."
 
 -- | Serve one file directly or a zip-archive of files, identified through a given DB query
+--
 -- Like `serveOneFile`, but sends a zip-archive if multiple results are returned
-serveSomeFiles :: Text -> DB [Entity File] -> Handler TypedContent
-serveSomeFiles archiveName query = do
-  results <- runDB query
+serveSomeFiles :: FilePath -> Source (YesodDB UniWorX) File -> Handler TypedContent
+serveSomeFiles archiveName source = do
+  results <- runDB . runConduit $ source .| peekN 2
+
+  $logDebugS "serveSomeFiles" . tshow $ length results
+  
   case results of
-    [] -> notFound
-    [Entity _fileId File{fileTitle, fileContent}]
-      | Just fileContent' <- fileContent -> do
-          whenM downloadFiles $
-            addHeader "Content-Disposition" [st|attachment; filename="#{takeFileName fileTitle}"|]
-          return $ TypedContent (mimeLookup (pack fileTitle) <> "; charset=utf-8") (toContent fileContent')
-      | otherwise -> sendResponseStatus noContent204 ()
-    files -> do
-      addHeader "Content-Disposition" [st|attachment; filename="#{toPathPiece archiveName}"|]
+    []         -> notFound
+    [file]     -> sendThisFile file
+    _moreFiles -> do
+      setContentDisposition' $ Just archiveName
       respondSourceDB "application/zip" $ do
-        let zipComment = T.encodeUtf8 archiveName
-        yieldMany files .| Conduit.map entityVal .| produceZip ZipInfo{..} .| Conduit.map toFlushBuilder
+        let zipComment = T.encodeUtf8 $ pack archiveName
+        source .| produceZip ZipInfo{..} .| Conduit.map toFlushBuilder
 
 
 tidFromText :: Text -> Maybe TermId
diff --git a/src/Handler/Utils/Communication.hs b/src/Handler/Utils/Communication.hs
index 843160372..7ee1f815a 100644
--- a/src/Handler/Utils/Communication.hs
+++ b/src/Handler/Utils/Communication.hs
@@ -9,7 +9,6 @@ module Handler.Utils.Communication
 
 import Import
 import Handler.Utils
-import Handler.Utils.Form.MassInput
 import Utils.Lens
 
 import Jobs.Queue
@@ -21,9 +20,6 @@ import Data.Map ((!), (!?))
 import qualified Data.Map as Map
 import qualified Data.Set as Set
 
-import Data.Aeson.TH
-import Data.Aeson.Types (ToJSONKey(..), FromJSONKey(..), toJSONKeyText, FromJSONKeyFunction(..))
-
 
 data RecipientGroup = RGCourseParticipants | RGCourseLecturers | RGCourseCorrectors | RGCourseTutors
                     | RGTutorialParticipants
diff --git a/src/Handler/Utils/Form.hs b/src/Handler/Utils/Form.hs
index 92fbccf72..12fdc847c 100644
--- a/src/Handler/Utils/Form.hs
+++ b/src/Handler/Utils/Form.hs
@@ -1,5 +1,6 @@
 module Handler.Utils.Form
   ( module Handler.Utils.Form
+  , module Handler.Utils.Form.MassInput
   , module Utils.Form
   , MonadWriter(..)
   ) where
@@ -35,6 +36,7 @@ import qualified Data.Map as Map
 import Control.Monad.Trans.Writer (execWriterT, WriterT)
 import Control.Monad.Trans.Except (throwE, runExceptT)
 import Control.Monad.Writer.Class
+import Control.Monad.Error.Class (MonadError(..))
 
 import Data.Scientific (Scientific)
 import Text.Read (readMaybe)
@@ -49,6 +51,13 @@ import Data.Proxy
 
 import qualified Text.Email.Validate as Email
 
+import Yesod.Core.Types (FileInfo(..))
+
+import System.FilePath (isExtensionOf)
+import Data.Text.Lens (unpacked)
+
+import Handler.Utils.Form.MassInput
+
 ----------------------------
 -- Buttons (new version ) --
 ----------------------------
@@ -341,14 +350,88 @@ studyFeaturesPrimaryFieldFor isOptional oldFeatures mbuid = selectField $ do
           }
 
 
-uploadModeField :: Field Handler UploadMode
-uploadModeField = selectField optionsFinite
+uploadModeForm :: Maybe UploadMode -> AForm Handler UploadMode
+uploadModeForm prev = multiActionA actions (fslI MsgSheetUploadMode) (classifyUploadMode <$> prev)
+  where
+    actions :: Map UploadModeDescr (AForm Handler UploadMode)
+    actions = Map.fromList
+      [ ( UploadModeNone, pure NoUpload)
+      , ( UploadModeAny
+        , UploadAny
+          <$> apreq checkBoxField (fslI MsgUploadModeUnpackZips & setTooltip MsgUploadModeUnpackZipsTip) (prev ^? _Just . _unpackZips)
+          <*> aopt extensionRestrictionField (fslI MsgUploadModeExtensionRestriction & setTooltip MsgUploadModeExtensionRestrictionTip) ((prev ^? _Just . _extensionRestriction) <|> fmap Just defaultExtensionRestriction)
+        )
+      , ( UploadModeSpecific
+        , UploadSpecific <$> specificFileForm
+        )
+      ]
+  
+    extensionRestrictionField :: Field Handler (NonNull (Set Extension))
+    extensionRestrictionField = checkMMap (return . maybe (Left MsgUploadModeExtensionRestrictionEmpty) Right . fromNullable . toSet) (intercalate ", " . Set.toList . toNullable) textField
+      where
+        toSet = Set.fromList . filter (not . Text.null) . map (stripDot . Text.strip) . Text.splitOn ","
+        stripDot ext
+          | Just nExt <- Text.stripPrefix "." ext = nExt
+          | otherwise = ext
+    
+    specificFileForm :: AForm Handler (NonNull (Set UploadSpecificFile))
+    specificFileForm = wFormToAForm $ do
+      Just currentRoute <- getCurrentRoute
+      let miButtonAction :: forall p. PathPiece p => p -> Maybe (SomeRoute UniWorX)
+          miButtonAction frag = Just . SomeRoute $ currentRoute :#: frag
+      miIdent <- ("specific-files--" <>) <$> newIdent
+      postProcess =<< massInputW MassInput{..} (fslI MsgUploadSpecificFiles & setTooltip MsgMassInputTip) True (preProcess <$> prev ^? _Just . _specificFiles)
+      where
+        preProcess :: NonNull (Set UploadSpecificFile) -> Map ListPosition (UploadSpecificFile, UploadSpecificFile)
+        preProcess = Map.fromList . zip [0..] . map (\x -> (x, x)) . Set.toList . toNullable
+        
+        postProcess :: FormResult (Map ListPosition (UploadSpecificFile, UploadSpecificFile)) -> WForm Handler (FormResult (NonNull (Set UploadSpecificFile)))
+        postProcess mapResult = do
+          MsgRenderer mr <- getMsgRenderer
+          return $ do
+            mapResult' <- Set.fromList . map snd . Map.elems <$> mapResult
+            case fromNullable mapResult' of
+              Nothing -> throwError [mr MsgNoUploadSpecificFilesConfigured]
+              Just lResult -> do
+                let names = Set.map specificFileName mapResult'
+                    labels = Set.map specificFileLabel mapResult'
+                if
+                  | Set.size names /= Set.size mapResult'
+                    -> throwError [mr MsgUploadSpecificFilesDuplicateNames]
+                  | Set.size labels /= Set.size mapResult'
+                    -> throwError [mr MsgUploadSpecificFilesDuplicateLabels]
+                  | otherwise
+                    -> return lResult
+
+        sFileForm :: (Text -> Text) -> Maybe UploadSpecificFile -> Form UploadSpecificFile
+        sFileForm nudge mPrevUF csrf = do
+          (labelRes, labelView) <- mpreq textField ("" & addName (nudge "label")) $ specificFileLabel <$> mPrevUF
+          (nameRes, nameView) <- mpreq textField ("" & addName (nudge "name")) $ specificFileName <$> mPrevUF
+          (reqRes, reqView) <- mpreq checkBoxField ("" & addName (nudge "required")) $ specificFileRequired <$> mPrevUF
+
+          return ( UploadSpecificFile <$> labelRes <*> nameRes <*> reqRes
+                 , $(widgetFile "widgets/massinput/uploadSpecificFiles/form")
+                 )
+
+        miAdd _ _ nudge submitView = Just $ \csrf -> do
+          (formRes, formWidget) <- sFileForm nudge Nothing csrf
+          let formWidget' = $(widgetFile "widgets/massinput/uploadSpecificFiles/add")
+              addRes' = formRes <&> \fileRes oldRess ->
+                let iStart = maybe 0 (succ . fst) $ Map.lookupMax oldRess
+                 in pure $ Map.singleton iStart fileRes
+          return (addRes', formWidget')
+        miCell _ initFile initFile' nudge csrf =
+          sFileForm nudge (Just $ fromMaybe initFile initFile') csrf
+        miDelete = miDeleteList
+        miAllowAdd _ _ _ = True
+        miAddEmpty _ _ _ = Set.empty
+        miLayout :: MassInputLayout ListLength UploadSpecificFile UploadSpecificFile
+        miLayout lLength _ cellWdgts delButtons addWdgts = $(widgetFile "widgets/massinput/uploadSpecificFiles/layout")
+                                               
 
 submissionModeForm :: Maybe SubmissionMode -> AForm Handler SubmissionMode
 submissionModeForm prev = multiActionA actions (fslI MsgSheetSubmissionMode) $ classifySubmissionMode <$> prev
   where
-    uploadModeForm = apreq uploadModeField (fslI MsgSheetUploadMode) (preview (_Just . _submissionModeUser . _Just) $ prev)
-
     actions :: Map SubmissionModeDescr (AForm Handler SubmissionMode)
     actions = Map.fromList
       [ ( SubmissionModeNone
@@ -358,10 +441,10 @@ submissionModeForm prev = multiActionA actions (fslI MsgSheetSubmissionMode) $ c
         , pure $ SubmissionMode True  Nothing
         )
       , ( SubmissionModeUser
-        , SubmissionMode False . Just <$> uploadModeForm
+        , SubmissionMode False . Just <$> uploadModeForm (prev ^? _Just . _submissionModeUser . _Just)
         )
       , ( SubmissionModeBoth
-        , SubmissionMode True  . Just <$> uploadModeForm
+        , SubmissionMode True  . Just <$> uploadModeForm (prev ^? _Just . _submissionModeUser . _Just)
         )
       ]
 
@@ -374,17 +457,41 @@ pseudonymWordField = checkMMap doCheck CI.original $ textField & addDatalist (re
       | otherwise
       = return . Left $ MsgUnknownPseudonymWord (CI.original w)
 
-zipFileField :: Bool -- ^ Unpack zips?
-             -> Field Handler (Source Handler File)
-zipFileField doUnpack = Field{..}
+specificFileField :: UploadSpecificFile -> Field Handler (Source Handler File)
+specificFileField UploadSpecificFile{..} = Field{..}
   where
     fieldEnctype = Multipart
     fieldParse _ files
-      | [f] <- files = return . Right . Just $ bool (yieldM . acceptFile) sourceFiles doUnpack f
+      | [f] <- files
+      = return . Right . Just $ yieldM (acceptFile f) .| modifyFileTitle (const $ unpack specificFileName)
+      | null files   = return $ Right Nothing
+      | otherwise    = return . Left $ SomeMessage MsgOnlyUploadOneFile
+    fieldView fieldId fieldName attrs _ req = $(widgetFile "widgets/specificFileField")
+
+    extensions = fileNameExtensions specificFileName
+    acceptRestricted = not $ null extensions
+    accept = Text.intercalate "," . map ("." <>) $ extensions
+
+
+zipFileField :: Bool -- ^ Unpack zips?
+             -> Maybe (NonNull (Set Extension)) -- ^ Restrictions on file extensions
+             -> Field Handler (Source Handler File)
+zipFileField doUnpack permittedExtensions = Field{..}
+  where
+    fieldEnctype = Multipart
+    fieldParse _ files
+      | [f@FileInfo{..}] <- files
+      , maybe True (anyOf (re _nullable . folded . unpacked) (`isExtensionOf` unpack fileName)) permittedExtensions || doUnpack
+      = return . Right . Just $ bool (yieldM . acceptFile) sourceFiles doUnpack f
       | null files   = return $ Right Nothing
       | otherwise    = return . Left $ SomeMessage MsgOnlyUploadOneFile
     fieldView fieldId fieldName attrs _ req = $(widgetFile "widgets/zipFileField")
 
+    zipExtensions = mimeExtensions "application/zip"
+
+    acceptRestricted = isJust permittedExtensions
+    accept = Text.intercalate "," . map ("." <>) $ bool [] (Set.toList zipExtensions) doUnpack ++ toListOf (_Just . re _nullable . folded) permittedExtensions
+
 multiFileField :: Handler (Set FileId) -> Field Handler (Source Handler (Either FileId File))
 multiFileField permittedFiles' = Field{..}
   where
@@ -590,23 +697,6 @@ jsonField hide = Field{..}
     |]
     fieldEnctype = UrlEncoded
 
-secretJsonField :: ( ToJSON a, FromJSON a
-                   , MonadHandler m
-                   , HandlerSite m ~ UniWorX
-                   )
-                => Field m a
-secretJsonField = Field{..}
-  where
-    fieldParse [v] [] = bimap (\_ -> SomeMessage MsgSecretJSONFieldDecryptFailure) Just <$> runExceptT (encodedSecretBoxOpen v)
-    fieldParse [] [] = return $ Right Nothing
-    fieldParse _ _ = return . Left $ SomeMessage MsgValueRequired
-    fieldView theId name attrs val _isReq = do
-      val' <- traverse (encodedSecretBox SecretBoxShort) val
-      [whamlet|
-        
-      |]
-    fieldEnctype = UrlEncoded
-
 boolField :: ( MonadHandler m
              , HandlerSite m ~ UniWorX
              )
diff --git a/src/Handler/Utils/Form/MassInput.hs b/src/Handler/Utils/Form/MassInput.hs
index cd5e4f5ac..dab7f1d51 100644
--- a/src/Handler/Utils/Form/MassInput.hs
+++ b/src/Handler/Utils/Form/MassInput.hs
@@ -1,4 +1,4 @@
-{-# OPTIONS_GHC -fno-warn-orphans #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-} -- tupleBoxCoord
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 
 module Handler.Utils.Form.MassInput
@@ -17,12 +17,9 @@ module Handler.Utils.Form.MassInput
 import Import
 import Utils.Form
 import Utils.Lens
-import Handler.Utils.Form (secretJsonField)
 import Handler.Utils.Form.MassInput.Liveliness
 import Handler.Utils.Form.MassInput.TH
 
-import Data.Aeson hiding (Result(..))
-
 import Algebra.Lattice hiding (join)
 
 import Text.Blaze (Markup)
diff --git a/src/Handler/Utils/Form/Occurences.hs b/src/Handler/Utils/Form/Occurences.hs
index f39ec3323..da0e7733f 100644
--- a/src/Handler/Utils/Form/Occurences.hs
+++ b/src/Handler/Utils/Form/Occurences.hs
@@ -4,7 +4,6 @@ module Handler.Utils.Form.Occurences
 
 import Import
 import Handler.Utils.Form
-import Handler.Utils.Form.MassInput
 import Handler.Utils.DateTime
 
 import qualified Data.Set as Set
diff --git a/src/Handler/Utils/Invitations.hs b/src/Handler/Utils/Invitations.hs
index ba80dd1fe..510da890b 100644
--- a/src/Handler/Utils/Invitations.hs
+++ b/src/Handler/Utils/Invitations.hs
@@ -32,7 +32,6 @@ import qualified Data.HashSet as HashSet
 
 import Data.Aeson (fromJSON)
 import qualified Data.Aeson as JSON
-import Data.Aeson.TH
 
 import Data.Proxy (Proxy(..))
 import Data.Typeable
diff --git a/src/Handler/Utils/Submission.hs b/src/Handler/Utils/Submission.hs
index 33168da0e..be6745a6a 100644
--- a/src/Handler/Utils/Submission.hs
+++ b/src/Handler/Utils/Submission.hs
@@ -13,27 +13,25 @@ module Handler.Utils.Submission
 
 import Import hiding (joinPath)
 import Jobs.Queue
-import Prelude (lcm)
 import Yesod.Core.Types (HandlerContents(..), ErrorResponse(..))
 
 import Utils.Lens
 
-import Control.Monad.State hiding (forM_, mapM_,foldM)
-import Control.Monad.Writer (MonadWriter(..), execWriterT)
-import Control.Monad.RWS.Lazy (RWST)
+import Control.Monad.State as State (StateT)
+import Control.Monad.State.Class as State
+import Control.Monad.Writer (MonadWriter(..), execWriterT, execWriter)
+import Control.Monad.RWS.Lazy (MonadRWS, RWST, execRWST)
 import qualified Control.Monad.Random as Rand
 import qualified System.Random.Shuffle as Rand (shuffleM)
 
 import Data.Maybe ()
 
-import qualified Data.List as List
 import Data.Set (Set)
 import qualified Data.Set as Set
-import Data.Map (Map)
+import Data.Map (Map, (!), (!?))
 import qualified Data.Map as Map
 
 import qualified Data.Text as Text
-import Data.Ratio
 
 import Data.Monoid (Monoid, Any(..), Sum(..))
 import Generics.Deriving.Monoid (memptydefault, mappenddefault)
@@ -43,6 +41,7 @@ import qualified Handler.Utils.Rating as Rating (extractRatings)
 import Handler.Utils.Delete
 
 import qualified Database.Esqueleto as E
+import qualified Database.Esqueleto.Utils.TH as E
 
 import qualified Data.Conduit.List as Conduit
 import Data.Conduit.ResumableSink
@@ -55,155 +54,178 @@ import Text.Hamlet (ihamletFile)
 import qualified Control.Monad.Catch as E (Handler(..))
 
 
-data AssignSubmissionException = NoCorrectorsByProportion
-  deriving (Typeable, Show)
+data AssignSubmissionException = NoCorrectors
+                               | NoCorrectorsByProportion
+                               | SubmissionsNotFound (NonNull (Set SubmissionId))
+  deriving (Eq, Ord, Read, Show, Generic, Typeable)
 
 instance Exception AssignSubmissionException
 
 -- | Assigns all submissions according to sheet corrector loads
-assignSubmissions :: SheetId -- ^ Sheet do distribute to correction
+assignSubmissions :: SheetId -- ^ Sheet to distribute to correctors
                   -> Maybe (Set SubmissionId) -- ^ Optionally restrict submission to consider
                   -> YesodDB UniWorX ( Set SubmissionId
                                      , Set SubmissionId
                                      ) -- ^ Returns assigned and unassigned submissions; unassigned submissions occur only if no tutors have an assigned load
 assignSubmissions sid restriction = do
     Sheet{..} <- getJust sid
-    correctors <- selectList [ SheetCorrectorSheet ==. sid, SheetCorrectorState ==. CorrectorNormal ] []
-    let
-      -- byTutorial' uid = join . Map.lookup uid $ Map.fromList [ (sheetCorrectorUser, byTutorial sheetCorrectorLoad) | Entity _ SheetCorrector{..} <- corrsTutorial ]
-      corrsTutorial = filter hasTutorialLoad correctors -- needed as List within Esqueleto
-      corrsProp  = filter hasPositiveLoad correctors
-      countsToLoad' :: UserId -> Bool
-      countsToLoad' uid = Map.findWithDefault True uid loadMap
-      loadMap :: Map UserId Bool
-      loadMap = Map.fromList [(sheetCorrectorUser,b) | Entity _ SheetCorrector{ sheetCorrectorLoad = (Load {byTutorial = Just b}), .. } <- corrsTutorial]
-
-    currentSubs <- E.select . E.from $ \(submission `E.LeftOuterJoin` tutor') -> do
-        let tutors = E.subList_select . E.from $ \(submissionUser `E.InnerJoin` tutorialUser `E.InnerJoin` tutorial `E.InnerJoin` tutor) -> do
-              -- Uncomment next line for equal chance between tutors, irrespective of the number of students per tutor per submission group
-              -- E.distinctOn [E.don $ tutorial E.^. TutorialTutor] $ do
-                E.on (tutorial       E.^. TutorialId         E.==. tutor        E.^. TutorTutorial)
-                E.on (tutorial       E.^. TutorialId         E.==. tutorialUser E.^. TutorialParticipantTutorial)
-                E.on (submissionUser E.^. SubmissionUserUser E.==. tutorialUser E.^. TutorialParticipantUser)
-                E.where_ (tutor   E.^. TutorUser `E.in_` E.valList (map (sheetCorrectorUser . entityVal) corrsTutorial))
-                return $ tutor E.^. TutorUser
-        E.on $ tutor' E.?. UserId `E.in_` E.justList tutors
-        E.where_ $ submission E.^. SubmissionSheet E.==. E.val sid
-             E.&&. maybe (E.val True) (submission E.^. SubmissionId `E.in_`) (E.valList . Set.toList <$> restriction)
-        return (submission E.^. SubmissionId, tutor' E.?. UserId)
-
-    let subTutor' :: Map SubmissionId (Set UserId)
-        subTutor' = Map.fromListWith Set.union $ currentSubs
-          & mapped._2 %~ (maybe Set.empty Set.singleton . E.unValue)
-          & mapped._1 %~ E.unValue
-
-    prevSubs <- E.select . E.from $ \((sheet `E.InnerJoin` sheetCorrector) `E.LeftOuterJoin` submission) -> do
-        E.on $ E.joinV (submission E.?. SubmissionRatingBy) E.==. E.just (sheetCorrector E.^. SheetCorrectorUser)
-        E.on $ sheetCorrector E.^. SheetCorrectorSheet E.==. sheet E.^. SheetId
-        let isByTutorial = E.exists . E.from $ \(submissionUser `E.InnerJoin` tutorialUser `E.InnerJoin` tutorial `E.InnerJoin` tutor) -> do
-              E.on (tutorial E.^. TutorialId E.==. tutor E.^. TutorTutorial)
-              E.on $ tutorial E.^. TutorialId E.==. tutorialUser E.^. TutorialParticipantTutorial
-              E.on $ submissionUser E.^. SubmissionUserUser E.==. tutorialUser E.^. TutorialParticipantUser
-              E.where_ $ tutor E.^. TutorUser E.==. sheetCorrector E.^. SheetCorrectorUser
-                   E.&&. submission E.?. SubmissionId E.==. E.just (submissionUser E.^. SubmissionUserSubmission)
-        E.where_ $ sheet E.^. SheetCourse E.==. E.val sheetCourse
-             E.&&. sheetCorrector E.^. SheetCorrectorUser `E.in_` E.valList (map (sheetCorrectorUser . entityVal) correctors)
-        return (sheetCorrector, isByTutorial, E.isNothing (submission E.?. SubmissionId))
+    correctorsRaw <- E.select . E.from $ \(sheet `E.InnerJoin` sheetCorrector) -> do
+      E.on $ sheet E.^. SheetId E.==. sheetCorrector E.^. SheetCorrectorSheet
+      E.where_ $ sheetCorrector E.^. SheetCorrectorState `E.in_` E.valList [CorrectorNormal, CorrectorMissing]
+      return (sheet E.^. SheetId, sheetCorrector)
 
     let
-      prevSubs' :: Map SheetId (Map UserId (Rational, Integer))
-      prevSubs' = Map.unionsWith (Map.unionWith $ \(prop, n) (_, n') -> (prop, n + n')) $ do
-        (Entity _ SheetCorrector{ sheetCorrectorLoad = Load{..}, .. }, E.Value isByTutorial, E.Value isPlaceholder) <- prevSubs
-        guard $ maybe True (not isByTutorial ||) byTutorial
-        let proportion
-              | CorrectorExcused <- sheetCorrectorState = 0
-              | otherwise                               = byProportion
-        return . Map.singleton sheetCorrectorSheet $ Map.singleton sheetCorrectorUser (proportion, bool 1 0 isPlaceholder)
+      correctors :: Map SheetId (Map UserId (Load, CorrectorState))
+      correctors = Map.fromList $ do
+        E.Value sheetId <- Set.toList $ setOf (folded . _1) correctorsRaw
+        let loads = Map.fromList $ do
+              (E.Value sheetId', Entity _ SheetCorrector{..})
+                <- correctorsRaw
+              guard $ sheetId' == sheetId
+              return (sheetCorrectorUser, (sheetCorrectorLoad, sheetCorrectorState))
+        return (sheetId, loads)
 
-      deficit :: Map UserId Integer
-      deficit = Map.filter (> 0) $ Map.foldr (Map.unionWith (+) . toDeficit) Map.empty prevSubs'
-
-      toDeficit :: Map UserId (Rational, Integer) -> Map UserId Integer
-      toDeficit assignments = toDeficit' <$> assignments
+      sheetCorrectors :: Map UserId Load
+      sheetCorrectors = Map.mapMaybe filterLoad $ correctors ! sid
         where
-          assigned' = getSum $ foldMap (Sum . snd) assignments
-          props = getSum $ foldMap (Sum . fst) assignments
+          filterLoad (l@Load{..}, CorrectorNormal) = l <$ guard (isJust byTutorial || byProportion /= 0)
+          filterLoad _ = Nothing
 
-          toDeficit' (prop, assigned) = let
-              target
-                | props == 0 = 0
-                | otherwise  = round $ fromInteger assigned' * (prop / props)
-            in target - assigned
+    unless (Map.member sid correctors) $
+      throwM NoCorrectors
 
-    $logDebugS "assignSubmissions" $ "Previous submissions: " <> tshow prevSubs'
-    $logDebugS "assignSubmissions" $ "Current deficit: " <> tshow deficit
+    submissionDataRaw <- E.select . E.from $ \((sheet `E.InnerJoin` submission `E.InnerJoin` submissionUser) `E.LeftOuterJoin` (tutorial `E.InnerJoin` tutorialUser `E.InnerJoin` tutor)) -> do
+      E.on $ tutor E.?. TutorTutorial E.==. tutorial E.?. TutorialId
+      E.on $ tutorialUser E.?. TutorialParticipantTutorial E.==. tutorial E.?. TutorialId
+      E.on $ tutorialUser E.?. TutorialParticipantUser E.==. E.just (submissionUser E.^. SubmissionUserUser)
+       E.&&. tutor E.?. TutorUser `E.in_` E.justList (E.valList $ foldMap Map.keys correctors)
+       E.&&. tutorial E.?. TutorialCourse E.==. E.just (E.val sheetCourse)
+      E.on $ submission E.^. SubmissionId E.==. submissionUser E.^. SubmissionUserSubmission
+      E.on $ submission E.^. SubmissionSheet E.==. sheet E.^. SheetId
+
+      E.where_ $ sheet E.^. SheetCourse E.==. E.val sheetCourse
+
+      return (sheet E.^. SheetId, submission, tutor E.?. TutorUser)
 
     let
-      lcd :: Integer
-      lcd = foldr lcm 1 $ map (denominator . byProportion . sheetCorrectorLoad . entityVal) corrsProp
-      wholeProps :: Map UserId Integer
-      wholeProps = Map.fromList [ ( sheetCorrectorUser, round $ byProportion * fromInteger lcd ) | Entity _ SheetCorrector{ sheetCorrectorLoad = Load{..}, .. } <- corrsProp ]
-      detQueueLength = fromIntegral (Map.size $ Map.filter (\tuts -> all countsToLoad' tuts) subTutor') - sum deficit
-      detQueue = concat . List.genericReplicate (detQueueLength `div` sum wholeProps) . concatMap (uncurry $ flip List.genericReplicate) $ Map.toList wholeProps
+      -- | All submissions in this course so far
+      submissionData :: Map SubmissionId
+                          ( Maybe UserId -- Corrector
+                          , Map UserId (Sum Natural) -- Tutors
+                          , SheetId
+                          )
+      submissionData = Map.fromListWith merge $ map process submissionDataRaw
+        where
+          process (E.Value sheetId, Entity subId Submission{..}, E.Value mTutId) = (subId, (submissionRatingBy, maybe Map.empty (flip Map.singleton $ Sum 1) $ assertM isCorrectorByTutorial mTutId, sheetId))
+          merge (corrA, tutorsA, sheetA) (corrB, tutorsB, sheetB)
+            | corrA /= corrB   = error "Same submission seen with different correctors"
+            | sheetA /= sheetB = error "Same submission seen with different sheets"
+            | otherwise        = (corrA, Map.unionWith mappend tutorsA tutorsB, sheetA)
 
-    $logDebugS "assignSubmissions" $ "Deterministic Queue: " <> tshow detQueue
+          -- Not done in esqueleto, since inspection of `Load`-Values is difficult
+          isCorrectorByTutorial = maybe False (\Load{..} -> is _Just byTutorial) . flip Map.lookup sheetCorrectors
 
-    queue <- liftIO . Rand.evalRandIO . execWriterT $ do
-      tell $ map Just detQueue
-      forever $
-        tell . pure =<< Rand.weightedMay [ (sheetCorrectorUser, byProportion sheetCorrectorLoad) | Entity _ SheetCorrector{..} <- corrsProp ]
+      targetSubmissions = Set.fromList $ do
+        (E.Value sheetId, Entity subId Submission{..}, _) <- submissionDataRaw
+        guard $ sheetId == sid
+        case restriction of
+          Just restriction' -> 
+            guard $ subId `Set.member` restriction'
+          Nothing ->
+            guard $ is _Nothing submissionRatingBy
+        return subId
 
-    $logDebugS "assignSubmissions" $ "Queue: " <> tshow (take (Map.size subTutor') queue)
+      targetSubmissionData = set _1 Nothing <$> Map.restrictKeys submissionData targetSubmissions
+      oldSubmissionData    = Map.withoutKeys submissionData targetSubmissions
+
+    whenIsJust (fromNullable =<< fmap (`Set.difference` targetSubmissions) restriction) $ \missing ->
+      throwM $ SubmissionsNotFound missing
 
     let
-      assignSubmission :: MonadState (Map SubmissionId UserId, [Maybe UserId], Map UserId Integer) m => Bool -> SubmissionId -> UserId -> m ()
-      assignSubmission countsToLoad smid tutid = do
-        _1 %= Map.insert smid tutid
-        _3 . at tutid %= assertM' (> 0) . maybe (-1) pred
-        when countsToLoad $
-          _2 %= List.delete (Just tutid)
+      withSubmissionData :: MonadRWS (Map SubmissionId a) w (Map SubmissionId a) m
+                         => (Map SubmissionId a -> b)
+                         -> m b
+      withSubmissionData f = f <$> (mappend <$> ask <*> State.get)
+      
+      -- | How many additional submission should the given corrector be assigned, if possible?
+      calculateDeficit :: UserId -> Map SubmissionId (Maybe UserId, Map UserId _, SheetId) -> Rational
+      calculateDeficit corrector submissionState = getSum $ foldMap Sum deficitBySheet
+        where
+          sheetSizes :: Map SheetId Integer
+          -- ^ Number of assigned submissions (to anyone) per sheet
+          sheetSizes = Map.map getSum . Map.fromListWith mappend $ do
+            (_, (Just _, _, sheetId)) <- Map.toList submissionState
+            return (sheetId, Sum 1)
 
-      maximumDeficit :: (MonadState (_a, _b, Map UserId Integer) m, MonadIO m) => m (Maybe UserId)
-      maximumDeficit = do
-        transposed <- uses _3 invertMap
-        traverse (liftIO . Rand.evalRandIO . Rand.uniform . snd) (Map.lookupMax transposed)
+          deficitBySheet :: Map SheetId Rational
+          -- ^ Deficite of @corrector@ per sheet
+          deficitBySheet = flip Map.mapMaybeWithKey sheetSizes $ \sheetId sheetSize -> do
+            let assigned :: Rational
+                assigned = fromIntegral . Map.size $ Map.filter (\(mCorr, _, sheetId') -> mCorr == Just corrector && sheetId == sheetId') submissionState
+                proportionSum :: Rational
+                proportionSum = getSum . foldMap corrProportion . fromMaybe Map.empty $ correctors !? sheetId
+                  where corrProportion (_, CorrectorExcused) = mempty
+                        corrProportion (Load{..}, _) = Sum byProportion
+                extra
+                  | Just (Load{..}, corrState) <- correctors !? sheetId >>= Map.lookup corrector
+                  = sum
+                    [ assigned
+                    , fromMaybe 0 $ do -- If corrections assigned by tutorial do not count against proportion, substract them from deficit
+                        tutCounts <- byTutorial
+                        guard $ not tutCounts
+                        guard $ corrState /= CorrectorExcused
+                        return . negate . fromIntegral . Map.size $ Map.filter (\(mCorr, tutors, sheetId') -> mCorr == Just corrector && sheetId == sheetId' && Map.member corrector tutors) submissionState
+                    , fromMaybe 0 $ do
+                        guard $ corrState /= CorrectorExcused
+                        return . negate $ (byProportion / proportionSum) * fromIntegral sheetSize
+                    ] 
+                  | otherwise
+                  = assigned
+            return $ negate extra
 
-    subTutor'' <- liftIO . Rand.evalRandIO . Rand.shuffleM $ Map.toList subTutor'
+    -- Sort target submissions by those that have tutors first and otherwise random
+    --
+    -- Deficit produced by restriction to tutors can thus be fixed by later submissions
+    targetSubmissions' <- liftIO . unstableSortBy (comparing $ \subId -> Map.null . view _2 $ submissionData ! subId) $ Set.toList targetSubmissions
 
-    subTutor <- fmap (view _1) . flip execStateT (Map.empty, queue, deficit) . forM_ subTutor'' $ \(smid, tuts) -> do
-      let
-        restrictTuts
-          | Set.null tuts = id
-          | otherwise     = flip Map.restrictKeys tuts
-      byDeficit <- withStateT (over _3 restrictTuts) maximumDeficit
-      case byDeficit of
-        Just q' -> do
-          $logDebugS "assignSubmissions" $ tshow smid <> " -> " <> tshow q' <> " (byDeficit)"
-          assignSubmission False smid q'
-        Nothing
-          | Set.null tuts -> do
-              q <- preuse $ _2 . _head . _Just
-              case q of
-                Just q' -> do
-                  $logDebugS "assignSubmissions" $ tshow smid <> " -> " <> tshow q' <> " (queue)"
-                  assignSubmission True smid q'
-                Nothing -> return ()
-          | otherwise -> do
-              q <- liftIO . Rand.evalRandIO $ Rand.uniform tuts
-              $logDebugS "assignSubmissions" $ tshow smid <> " -> " <> tshow q <> " (tutorial)"
-              assignSubmission (countsToLoad' q) smid q
+    (newSubmissionData, ()) <- (\act -> execRWST act oldSubmissionData targetSubmissionData) . forM_ (zip [1..] targetSubmissions') $ \(i, subId) -> do
+      tutors <- gets $ view _2 . (! subId) -- :: Map UserId (Sum Natural)
+      let acceptableCorrectors
+            | correctorsByTut <- Map.filter (is _Just . view _byTutorial) $ sheetCorrectors `Map.restrictKeys` Map.keysSet tutors
+            , not $ null correctorsByTut
+            = Map.keysSet correctorsByTut
+            | otherwise
+            = Map.keysSet $ Map.filter (views _byProportion (/= 0)) sheetCorrectors
+
+      when (not $ null acceptableCorrectors) $ do
+        deficits <- sequence . flip Map.fromSet acceptableCorrectors $ withSubmissionData . calculateDeficit
+        let
+          bestCorrectors :: Set UserId
+          bestCorrectors = acceptableCorrectors
+            & maximumsBy (deficits !)
+            & maximumsBy (tutors !?)
+
+        $logDebugS "assignSubmissions" [st|#{tshow i} Tutors for #{tshow subId}: #{tshow tutors}|]
+        $logDebugS "assignSubmissions" [st|#{tshow i} Current (#{tshow subId}) relevant deficits: #{tshow deficits}|]
+        $logDebugS "assignSubmissions" [st|#{tshow i} Assigning #{tshow subId} to one of #{tshow bestCorrectors}|]
+
+        ix subId . _1 <~ Just <$> liftIO (Rand.uniform bestCorrectors)
 
     now <- liftIO getCurrentTime
-    forM_ (Map.toList subTutor) $
-        \(smid, tutid) -> update smid [ SubmissionRatingBy       =. Just tutid
-                                      , SubmissionRatingAssigned =. Just now  ]
+    execWriterT . forM_ (Map.toList newSubmissionData) $ \(subId, (mCorrector, _, _)) -> case mCorrector of
+      Just corrector -> do
+        lift $ update subId [ SubmissionRatingBy       =. Just corrector
+                            , SubmissionRatingAssigned =. Just now
+                            ]
+        tell (Set.singleton subId, mempty)
+      Nothing ->
+        tell (mempty, Set.singleton subId)
+  where
+    maximumsBy :: (Ord a, Ord b) => (a -> b) -> Set a -> Set a
+    maximumsBy f xs = flip Set.filter xs $ \x -> maybe True (((==) `on` f) x . maximumBy (comparing f)) $ fromNullable xs
 
-    let assignedSubmissions   = Map.keysSet subTutor
-        unassigendSubmissions = Map.keysSet subTutor' \\ assignedSubmissions
-    return (assignedSubmissions, unassigendSubmissions)
-    where
-      hasPositiveLoad = (> 0)  . byProportion . sheetCorrectorLoad . entityVal
-      hasTutorialLoad = isJust . byTutorial   . sheetCorrectorLoad . entityVal
+    unstableSortBy :: MonadRandom m => (a -> a -> Ordering) -> [a] -> m [a]
+    unstableSortBy cmp = fmap concat . mapM Rand.shuffleM . groupBy (\a b -> cmp a b == EQ) . sortBy cmp
 
 
 submissionFileSource :: SubmissionId -> Source (YesodDB UniWorX) (Entity File)
@@ -223,17 +245,34 @@ submissionMultiArchive (Set.toList -> ids) = do
   (dbrunner, cleanup) <- getDBRunner
 
   ratedSubmissions <- runDBRunner dbrunner $ do
-    submissions <- selectList [ SubmissionId <-. ids ] []
-    forM submissions $ \s@(Entity submissionId _) -> maybe (invalidArgs ["Invalid submission numbers"]) (return . (, s)) =<< getRating submissionId
+    submissions <- E.select . E.from $ \(course `E.InnerJoin` sheet `E.InnerJoin` submission) -> do
+      E.on $ sheet E.^. SheetId     E.==. submission E.^. SubmissionSheet
+      E.on $ sheet E.^. SheetCourse E.==. course E.^. CourseId
+      E.where_ $ submission E.^. SubmissionId `E.in_` E.valList ids
+      return (submission, (sheet E.^. SheetName, course E.^. CourseShorthand, course E.^. CourseSchool, course E.^. CourseTerm))
+
+    forM submissions $ \(s@(Entity submissionId _), courseSheetInfo) ->
+       maybe (invalidArgs ["Invalid submission numbers"]) (return . (, s, $(E.unValueN 4) courseSheetInfo)) =<< getRating submissionId
+  let (setSheet,setCourse,setSchool,setTerm) =
+        execWriter . forM ratedSubmissions $ \(_rating,_submission,(shn,csh,ssh,tid)) ->
+          tell (Set.singleton shn, Set.singleton csh, Set.singleton ssh, Set.singleton tid)
 
   (<* cleanup) . respondSource "application/zip" . transPipe (runDBRunner dbrunner) $ do
     let
-      fileEntitySource' :: (Rating, Entity Submission) -> Source (YesodDB UniWorX) File
-      fileEntitySource' (rating, Entity submissionID Submission{..}) = do
+      fileEntitySource' :: (Rating, Entity Submission, (SheetName,CourseShorthand,SchoolId,TermId)) -> Source (YesodDB UniWorX) File
+      fileEntitySource' (rating, Entity submissionID Submission{..},(shn,csh,ssh,tid)) = do
         cID <- encrypt submissionID
 
         let
-          directoryName = Text.unpack $ toPathPiece (cID :: CryptoFileNameSubmission)
+          dirFrag :: PathPiece p => p -> FilePath
+          dirFrag = Text.unpack . toPathPiece
+          submissionDirectory  = dirFrag (cID :: CryptoFileNameSubmission)
+          directoryName
+            | Set.size setTerm   > 1 = dirFrag tid  dirFrag ssh  dirFrag csh  dirFrag shn  submissionDirectory
+            | Set.size setSchool > 1 =                 dirFrag ssh  dirFrag csh  dirFrag shn  submissionDirectory
+            | Set.size setCourse > 1 =                                 dirFrag csh  dirFrag shn  submissionDirectory
+            | Set.size setSheet  > 1 =                                                 dirFrag shn  submissionDirectory
+            | otherwise              =                                                                 submissionDirectory
 
           fileEntitySource = do
             submissionFileSource submissionID =$= Conduit.map entityVal
@@ -300,8 +339,10 @@ extractRatingsMsg = do
   let ignoredFiles :: Set (Either CryptoFileNameSubmission FilePath)
       ignoredFiles = Right `Set.map` ignored'
   unless (null ignoredFiles) $ do
-    mr <- (toHtml . ) <$> getMessageRender
-    addMessage Warning =<< withUrlRenderer ($(ihamletFile "templates/messages/submissionFilesIgnored.hamlet") mr)
+    let ignoredModal = msgModal
+          [whamlet|_{MsgSubmissionFilesIgnored (Set.size ignoredFiles)}|]
+          (Right $(widgetFile "messages/submissionFilesIgnored"))
+    addMessageWidget Warning ignoredModal
 
 -- Nicht innerhalb von runDB aufrufen, damit das DB Rollback passieren kann!
 msgSubmissionErrors :: (MonadHandler m, MonadCatch m, HandlerSite m ~ UniWorX) => m a -> m (Maybe a)
@@ -344,10 +385,28 @@ sinkSubmission userId mExists isUpdate = do
       return sId
     Right sId -> return sId
 
-  sId <$ sinkSubmission' sId
+  Sheet{..} <- lift $ case mExists of
+    Left sheetId -> getJust sheetId
+    Right subId  -> getJust . submissionSheet =<< getJust subId
+
+  sId <$ (guardFileTitles sheetSubmissionMode .| sinkSubmission' sId)
   where
     tellSt = modify . mappend
 
+    guardFileTitles :: MonadThrow m => SubmissionMode -> Conduit SubmissionContent m SubmissionContent
+    guardFileTitles SubmissionMode{..}
+      | Just UploadAny{..} <- submissionModeUser
+      , not isUpdate
+      , Just (map unpack . Set.toList . toNullable -> exts) <- extensionRestriction
+      = Conduit.mapM $ \x -> if
+          | Left File{..} <- x
+          , none (`isExtensionOf` fileTitle) exts
+          , isn't _Nothing fileContent -- File record is not a directory, we don't care about those
+            -> throwM $ InvalidFileTitleExtension fileTitle
+          | otherwise
+            -> return x
+      | otherwise = Conduit.map id
+
     sinkSubmission' :: SubmissionId
                     -> Sink SubmissionContent (YesodJobDB UniWorX) ()
     sinkSubmission' submissionId = lift . finalize <=< execStateLC mempty . Conduit.mapM_ $ \case
diff --git a/src/Handler/Utils/Table/Pagination.hs b/src/Handler/Utils/Table/Pagination.hs
index 15a2952f5..063b06fd6 100644
--- a/src/Handler/Utils/Table/Pagination.hs
+++ b/src/Handler/Utils/Table/Pagination.hs
@@ -1,5 +1,3 @@
-{-# OPTIONS -fno-warn-orphans #-}
-
 module Handler.Utils.Table.Pagination
   ( module Handler.Utils.Table.Pagination.Types
   , SortColumn(..), SortDirection(..)
diff --git a/src/Import/NoFoundation.hs b/src/Import/NoFoundation.hs
index 7006bd5e5..0577f3915 100644
--- a/src/Import/NoFoundation.hs
+++ b/src/Import/NoFoundation.hs
@@ -1,105 +1,17 @@
 module Import.NoFoundation
     ( module Import
-    , MForm
     ) where
 
-import ClassyPrelude.Yesod    as Import hiding (formatTime, derivePersistFieldJSON, addMessage, addMessageI, (.=), MForm, Proxy, foldlM, static, boolField, identifyForm, cons)
+import Import.NoModel         as Import
 import Model                  as Import
-import Model.Types.JSON       as Import
 import Model.Migration        as Import
 import Model.Rating           as Import
 import Model.Submission       as Import
 import Model.Tokens           as Import
+import Utils.Tokens           as Import
+import Utils.Frontend.Modal   as Import
+
 import Settings               as Import
 import Settings.StaticFiles   as Import
-import Yesod.Auth             as Import
-import Yesod.Core.Types       as Import (loggerSet)
-import Yesod.Default.Config2  as Import
-import Utils                  as Import
-import Utils.Frontend.Modal   as Import
-import Utils.Frontend.I18n    as Import
-import Utils.DB               as Import
-import Yesod.Core.Json        as Import (provideJson)
-import Yesod.Core.Types.Instances as Import (CachedMemoT(..))
-
-import Language.Haskell.TH.Instances as Import ()
-
-import Utils.Tokens           as Import
-
-
-import Data.Fixed             as Import
 
 import CryptoID               as Import
-import Data.UUID              as Import (UUID)
-
-import Text.Lucius            as Import
-
-import Text.Shakespeare.Text  as Import hiding (text, stext)
-
-import Data.Universe          as Import
-import Data.Universe.TH       as Import
-import Data.Pool              as Import (Pool)
-import Network.HaskellNet.SMTP as Import (SMTPConnection)
-
-import Mail                   as Import
-
-import Data.Data              as Import (Data)
-import Data.Typeable          as Import (Typeable)
-import GHC.Generics           as Import (Generic)
-import GHC.Exts               as Import (IsList)
-
-import Data.Hashable          as Import
-import Data.List.NonEmpty     as Import (NonEmpty(..), nonEmpty)
-import Data.List.NonEmpty.Instances as Import ()
-import Data.NonNull.Instances as Import ()
-import Data.Text.Encoding.Error as Import(UnicodeException(..))
-import Data.Semigroup         as Import (Semigroup)
-import Data.Monoid            as Import (Last(..), First(..), Any(..), All(..), Sum(..))
-import Data.Monoid.Instances  as Import ()
-import Data.Set.Instances     as Import ()
-import Data.HashMap.Strict.Instances as Import ()
-import Data.HashSet.Instances as Import ()
-import Data.Vector.Instances  as Import ()
-import Data.Time.Clock.Instances as Import ()
-
-import Data.Binary            as Import (Binary)
-
-import Control.Monad.Morph    as Import (MFunctor(..))
-
-import Control.Monad.Trans.Resource as Import (ReleaseKey)
-
-import Network.Mail.Mime.Instances as Import ()
-import Yesod.Core.Instances as Import ()
-import Data.Aeson.Types.Instances as Import ()
-
-import Ldap.Client.Pool as Import
-
-import Database.Esqueleto.Instances as Import ()
-import Database.Persist.Sql.Instances as Import ()
-import Database.Persist.Sql as Import (SqlReadT,SqlWriteT)
-import Database.Persist.Types.Instances as Import ()
-
-import Numeric.Natural.Instances as Import ()
-import System.Random as Import (Random)
-import Control.Monad.Random.Class as Import (MonadRandom(..))
-
-import Text.Blaze.Instances as Import ()
-import Jose.Jwt.Instances as Import ()
-import Jose.Jwt as Import (Jwt)
-import Web.PathPieces.Instances as Import ()
-
-import Data.Time.Calendar as Import
-import Data.Time.Clock as Import
-import Data.Time.LocalTime as Import hiding (utcToLocalTime, localTimeToUTC)
-import Time.Types as Import (WeekDay(..))
-
-import Time.Types.Instances as Import ()
-
-import Data.CaseInsensitive as Import (CI, FoldCase(..), foldedCase)
-
-import Data.Ratio as Import ((%))
-
-
-import Control.Monad.Trans.RWS (RWST)
-
-type MForm m = RWST (Maybe (Env, FileEnv), HandlerSite m, [Lang]) Enctype Ints m
diff --git a/src/Import/NoModel.hs b/src/Import/NoModel.hs
new file mode 100644
index 000000000..639eca131
--- /dev/null
+++ b/src/Import/NoModel.hs
@@ -0,0 +1,105 @@
+module Import.NoModel
+  ( module Import
+  , MForm
+  ) where
+
+import ClassyPrelude.Yesod    as Import hiding (formatTime, derivePersistFieldJSON, addMessage, addMessageI, (.=), MForm, Proxy, foldlM, static, boolField, identifyForm, cons)
+
+import Model.Types.TH.JSON as Import
+import Model.Types.TH.Wordlist as Import
+
+import Mail                   as Import
+
+import Yesod.Auth             as Import
+import Yesod.Core.Types       as Import (loggerSet)
+import Yesod.Default.Config2  as Import
+import Yesod.Core.Json        as Import (provideJson)
+import Yesod.Core.Types.Instances as Import (CachedMemoT(..))
+
+import Utils                  as Import
+import Utils.Frontend.I18n    as Import
+import Utils.DB               as Import
+
+import Data.Fixed             as Import
+
+import Data.UUID              as Import (UUID)
+
+import Data.CaseInsensitive   as Import (CI, FoldCase(..), foldedCase)
+
+import Text.Lucius            as Import
+import Text.Shakespeare.Text  as Import hiding (text, stext)
+
+import Data.Universe          as Import
+import Data.Universe.TH       as Import
+import Data.Pool              as Import (Pool)
+import Network.HaskellNet.SMTP as Import (SMTPConnection)
+
+import Data.Data              as Import (Data)
+import Data.Typeable          as Import (Typeable)
+import GHC.Generics           as Import (Generic)
+import GHC.Exts               as Import (IsList)
+import Data.Ix                as Import (Ix)
+
+import Data.Hashable          as Import
+import Data.List.NonEmpty     as Import (NonEmpty(..), nonEmpty)
+import Data.Text.Encoding.Error as Import(UnicodeException(..))
+import Data.Semigroup         as Import (Semigroup)
+import Data.Monoid            as Import (Last(..), First(..), Any(..), All(..), Sum(..))
+import Data.Binary            as Import (Binary)
+
+import Numeric.Natural        as Import (Natural)
+import Data.Ratio             as Import ((%))
+
+import Database.Persist.Sql as Import (SqlReadT, SqlWriteT, fromSqlKey, toSqlKey)
+  
+import Ldap.Client.Pool as Import
+
+import System.Random as Import (Random(..))
+import Control.Monad.Random.Class as Import (MonadRandom(..))
+
+import Control.Monad.Morph    as Import (MFunctor(..))
+import Control.Monad.Trans.Resource as Import (ReleaseKey)
+
+import Jose.Jwt as Import (Jwt)
+
+import Data.Time.Calendar as Import
+import Data.Time.Clock as Import
+import Data.Time.LocalTime as Import hiding (utcToLocalTime, localTimeToUTC)
+import Time.Types as Import (WeekDay(..))
+
+import Network.Mime as Import
+  
+import Data.Aeson.TH as Import
+import Data.Aeson.Types as Import (FromJSON(..), ToJSON(..), FromJSONKey(..), ToJSONKey(..), toJSONKeyText, FromJSONKeyFunction(..), ToJSONKeyFunction(..), Value)
+
+import Language.Haskell.TH.Instances as Import ()
+import Data.List.NonEmpty.Instances as Import ()
+import Data.NonNull.Instances as Import ()
+import Data.Monoid.Instances  as Import ()
+import Data.Set.Instances     as Import ()
+import Data.HashMap.Strict.Instances as Import ()
+import Data.HashSet.Instances as Import ()
+import Data.Vector.Instances  as Import ()
+import Data.Time.Clock.Instances as Import ()
+import Data.Time.LocalTime.Instances as Import ()
+import Data.Time.Calendar.Instances as Import ()
+import Data.Time.Format.Instances as Import ()
+import Time.Types.Instances as Import ()
+import Network.Mail.Mime.Instances as Import ()
+import Yesod.Core.Instances as Import ()
+import Data.Aeson.Types.Instances as Import ()
+import Database.Esqueleto.Instances as Import ()
+import Numeric.Natural.Instances as Import ()
+import Text.Blaze.Instances as Import ()
+import Jose.Jwt.Instances as Import ()
+import Web.PathPieces.Instances as Import ()
+import Data.Universe.Instances.Reverse.MonoTraversable ()
+import Database.Persist.Class.Instances as Import ()
+import Database.Persist.Types.Instances as Import ()
+import Data.UUID.Instances as Import ()
+import System.FilePath.Instances as Import ()
+
+
+import Control.Monad.Trans.RWS (RWST)
+
+type MForm m = RWST (Maybe (Env, FileEnv), HandlerSite m, [Lang]) Enctype Ints m
diff --git a/src/Jobs.hs b/src/Jobs.hs
index efbe126b6..5ba9f1fa4 100644
--- a/src/Jobs.hs
+++ b/src/Jobs.hs
@@ -32,6 +32,7 @@ import Control.Monad.Random (evalRand, mkStdGen, getRandomR)
 import Cron
 import qualified Data.HashMap.Strict as HashMap
 import Data.HashMap.Strict (HashMap)
+import qualified Data.Set as Set
 
 import qualified Data.List.NonEmpty as NonEmpty
 
@@ -51,8 +52,6 @@ import Data.Time.Zones
 
 import Control.Concurrent.STM (retry)
 
-import qualified System.Systemd.Daemon as Systemd
-
 
 import Jobs.Handler.SendNotification
 import Jobs.Handler.SendTestEmail
@@ -284,21 +283,19 @@ handleJobs' wNum = C.mapM_ $ \jctl -> do
       -- logDebugS logIdent $ tshow newCTab
       mapReaderT (liftIO . atomically) $ 
         lift . void . flip swapTMVar newCTab =<< asks jobCrontab
-    handleCmd JobCtlGenerateHealthReport = do
+    handleCmd (JobCtlGenerateHealthReport kind) = do
       hrStorage <- getsYesod appHealthReport
-      newReport@(classifyHealthReport -> newStatus) <- lift generateHealthReport
+      newReport@(healthReportStatus -> newStatus) <- lift $ generateHealthReport kind
 
-      $logInfoS "HealthReport" $ toPathPiece newStatus
+      $logInfoS (tshow kind) $ toPathPiece newStatus
       unless (newStatus == HealthSuccess) $ do
-        $logErrorS "HealthReport" $ tshow newReport
+        $logErrorS (tshow kind) $ tshow newReport
   
       liftIO $ do
         now <- getCurrentTime
-        atomically . writeTVar hrStorage $ Just (now, newReport)
-        
-        void . Systemd.notifyStatus . unpack $ toPathPiece newStatus
-        when (newStatus == HealthSuccess) $
-          void Systemd.notifyWatchdog
+        let updateReports = Set.insert (now, newReport)
+                          . Set.filter (((/=) `on` classifyHealthReport) newReport . snd)
+        atomically . modifyTVar' hrStorage $ force . updateReports
 
 jLocked :: QueuedJobId -> (QueuedJob -> Handler a) -> Handler a
 jLocked jId act = do
diff --git a/src/Jobs/Crontab.hs b/src/Jobs/Crontab.hs
index 5dd98d9b8..aecca927e 100644
--- a/src/Jobs/Crontab.hs
+++ b/src/Jobs/Crontab.hs
@@ -2,18 +2,17 @@ module Jobs.Crontab
   ( determineCrontab
   ) where
 
-import Import
+import Import 
 
 import qualified Data.HashMap.Strict as HashMap
 import Jobs.Types
 
-import Data.Maybe (fromJust)
 import qualified Data.Map as Map
 import Data.Semigroup (Max(..))
 
 import Data.Time.Zones
 
-import Control.Monad.Trans.Writer (execWriterT)
+import Control.Monad.Trans.Writer (WriterT, execWriterT)
 import Control.Monad.Writer.Class (MonadWriter(..))
 
 import qualified Data.Conduit.List as C
@@ -44,14 +43,17 @@ determineCrontab = execWriterT $ do
       , cronNotAfter = Right CronNotScheduled
       }
 
-  tell $ HashMap.singleton
-    JobCtlGenerateHealthReport
-    Cron
-      { cronInitial = CronAsap
-      , cronRepeat = CronRepeatScheduled CronAsap
-      , cronRateLimit = appHealthCheckInterval
-      , cronNotAfter = Right CronNotScheduled
-      }
+  tell . flip foldMap universeF $ \kind -> 
+    case appHealthCheckInterval kind of
+      Just int -> HashMap.singleton
+        (JobCtlGenerateHealthReport kind)
+        Cron
+          { cronInitial = CronAsap
+          , cronRepeat = CronRepeatScheduled CronAsap
+          , cronRateLimit = int
+          , cronNotAfter = Right CronNotScheduled
+          }
+      Nothing  -> mempty
 
   let
     sheetJobs (Entity nSheet Sheet{..}) = do
@@ -88,28 +90,31 @@ determineCrontab = execWriterT $ do
             , cronRateLimit = 3600 -- Irrelevant due to `cronRepeat`
             , cronNotAfter  = Left nominalDay
             }
-      
-      sheetSubmissions <- lift $ collateSubmissions <$> 
-          selectList [SubmissionRatingBy !=. Nothing, SubmissionSheet ==. nSheet] []      
-      tell $ flip Map.foldMapWithKey sheetSubmissions $
-        \nUser (Max mbTime) -> if
-          |  Just time <- mbTime -> HashMap.singleton 
-              (JobCtlQueue $ JobQueueNotification NotificationCorrectionsAssigned { nUser, nSheet } )
-              Cron 
-                { cronInitial   = CronTimestamp $ utcToLocalTimeTZ appTZ $ addUTCTime appNotificationCollateDelay time
-                , cronRepeat    = CronRepeatNever
-                , cronRateLimit = appNotificationRateLimit
-                , cronNotAfter  = Left appNotificationExpiration
-                }
-          | otherwise -> mempty
 
   runConduit $ transPipe lift (selectSource [] []) .| C.mapM_ sheetJobs
 
--- | Partial function: Submission must not have Nothing at ratingBy
-collateSubmissions :: [Entity Submission] -> Map UserId (Max (Maybe UTCTime))
-collateSubmissions = Map.fromListWith (<>) . fmap procCorrector
-    where 
-      procCorrector :: Entity Submission -> (UserId ,Max (Maybe UTCTime))
-      procCorrector = (,) <$> fromJust . submissionRatingBy . entityVal 
-                          <*> Max . submissionRatingAssigned . entityVal
-      
+  let
+    correctorNotifications :: Map (UserId, SheetId) (Max UTCTime) -> WriterT (Crontab JobCtl) DB ()
+    correctorNotifications = (tell .) . Map.foldMapWithKey $ \(nUser, nSheet) (Max time) -> HashMap.singleton
+      (JobCtlQueue $ JobQueueNotification NotificationCorrectionsAssigned { nUser, nSheet } )
+      Cron 
+        { cronInitial   = CronTimestamp . utcToLocalTimeTZ appTZ $ addUTCTime appNotificationCollateDelay time
+        , cronRepeat    = CronRepeatNever
+        , cronRateLimit = appNotificationRateLimit
+        , cronNotAfter  = Left appNotificationExpiration
+        }
+    
+    submissionsByCorrector :: Entity Submission -> Map (UserId, SheetId) (Max UTCTime)
+    submissionsByCorrector (Entity _ sub)
+      | Just ratingBy <- submissionRatingBy sub
+      , Just assigned <- submissionRatingAssigned sub
+      , not $ submissionRatingDone sub
+      = Map.singleton (ratingBy, submissionSheet sub) $ Max assigned
+      | otherwise
+      = Map.empty
+
+    collateSubmissionsByCorrector acc entity = Map.unionWith (<>) acc $ submissionsByCorrector entity
+  correctorNotifications <=< runConduit $
+       transPipe lift ( selectSource [ SubmissionRatingBy !=. Nothing, SubmissionRatingAssigned !=. Nothing ] []
+                      )
+    .| C.fold collateSubmissionsByCorrector Map.empty
diff --git a/src/Jobs/HealthReport.hs b/src/Jobs/HealthReport.hs
index a8f6a0ff4..45500a8bb 100644
--- a/src/Jobs/HealthReport.hs
+++ b/src/Jobs/HealthReport.hs
@@ -28,18 +28,13 @@ import qualified Network.HaskellNet.SMTP as SMTP
 import Data.Pool (withResource)
 
 
-generateHealthReport :: Handler HealthReport
-generateHealthReport
-  = runConcurrently $ HealthReport
-    <$> Concurrently matchingClusterConfig
-    <*> Concurrently httpReachable
-    <*> Concurrently ldapAdmins
-    <*> Concurrently smtpConnect
-    <*> Concurrently widgetMemcached
+generateHealthReport :: HealthCheck -> Handler HealthReport
+generateHealthReport = $(dispatchTH ''HealthCheck)
   
-matchingClusterConfig :: Handler Bool
+dispatchHealthCheckMatchingClusterConfig :: Handler HealthReport
 -- ^ Can the cluster configuration be read from the database and does it match our configuration?
-matchingClusterConfig = runDB $ and <$> forM universeF clusterSettingMatches
+dispatchHealthCheckMatchingClusterConfig
+  = fmap HealthMatchingClusterConfig . runDB $ and <$> forM universeF clusterSettingMatches
   where
     clusterSettingMatches ClusterCryptoIDKey = do
       ourSetting <- getsYesod appCryptoIDKey
@@ -74,11 +69,11 @@ matchingClusterConfig = runDB $ and <$> forM universeF clusterSettingMatches
         _other                 -> return Nothing
 
 
-httpReachable :: Handler (Maybe Bool)
-httpReachable = do
+dispatchHealthCheckHTTPReachable :: Handler HealthReport
+dispatchHealthCheckHTTPReachable = HealthHTTPReachable <$> do
   staticAppRoot <- getsYesod $ view _appRoot
   doHTTP <- getsYesod $ view _appHealthCheckHTTP
-  for (staticAppRoot <* guard doHTTP) $ \_textAppRoot -> do
+  for (staticAppRoot <* guard doHTTP) $ \_ -> do
     url <- getUrlRender <*> pure InstanceR
     baseRequest <- HTTP.parseRequest $ unpack url
     httpManager <- getsYesod appHttpManager
@@ -88,8 +83,8 @@ httpReachable = do
     getsYesod $ (== clusterId) . appClusterID
 
 
-ldapAdmins :: Handler (Maybe Rational)
-ldapAdmins = do
+dispatchHealthCheckLDAPAdmins :: Handler HealthReport
+dispatchHealthCheckLDAPAdmins = HealthLDAPAdmins <$> do
   ldapPool' <- getsYesod appLdapPool
   ldapConf' <- getsYesod $ view _appLdapConf
   ldapAdminUsers <- fmap (map E.unValue) . runDB . E.select . E.from $ \(user `E.InnerJoin` lecturer) -> E.distinctOnOrderBy [E.asc $ user E.^. UserId] $ do
@@ -109,8 +104,8 @@ ldapAdmins = do
     _other -> return Nothing
 
 
-smtpConnect :: Handler (Maybe Bool)
-smtpConnect = do
+dispatchHealthCheckSMTPConnect :: Handler HealthReport
+dispatchHealthCheckSMTPConnect = HealthSMTPConnect <$> do
   smtpPool <- getsYesod appSmtpPool
   for smtpPool . flip withResource $ \smtpConn -> do
     response@(rCode, _) <- liftIO $ SMTP.sendCommand smtpConn SMTP.NOOP
@@ -121,8 +116,8 @@ smtpConnect = do
         return False
 
 
-widgetMemcached :: Handler (Maybe Bool)
-widgetMemcached = do
+dispatchHealthCheckWidgetMemcached :: Handler HealthReport
+dispatchHealthCheckWidgetMemcached = HealthWidgetMemcached <$> do
   memcachedConn <- getsYesod appWidgetMemcached
   for memcachedConn $ \_memcachedConn' -> do
     let ext = "bin"
diff --git a/src/Jobs/Types.hs b/src/Jobs/Types.hs
index f333f0c7d..3522ff802 100644
--- a/src/Jobs/Types.hs
+++ b/src/Jobs/Types.hs
@@ -69,7 +69,7 @@ data JobCtl = JobCtlFlush
             | JobCtlPerform QueuedJobId
             | JobCtlDetermineCrontab
             | JobCtlQueue Job
-            | JobCtlGenerateHealthReport
+            | JobCtlGenerateHealthReport HealthCheck
   deriving (Eq, Ord, Read, Show, Generic, Typeable)
 
 instance Hashable JobCtl
diff --git a/src/Mail.hs b/src/Mail.hs
index 82bac2273..8cfa03200 100644
--- a/src/Mail.hs
+++ b/src/Mail.hs
@@ -35,7 +35,9 @@ module Mail
   , _partType, _partEncoding, _partFilename, _partHeaders, _partContent
   ) where
 
-import ClassyPrelude.Yesod hiding (snoc, (.=), getMessageRender)
+import ClassyPrelude.Yesod hiding (snoc, (.=), getMessageRender, derivePersistFieldJSON)
+
+import Model.Types.TH.JSON
 
 import Network.Mail.Mime hiding (addPart, addAttachment)
 import qualified Network.Mail.Mime as Mime (addPart)
@@ -159,6 +161,7 @@ instance Default MailLanguages where
 
 instance Hashable MailLanguages
 
+
 data MailContext = MailContext
   { mcLanguages :: MailLanguages
   , mcDateTimeFormat :: SelDateTimeFormat -> DateTimeFormat
@@ -506,3 +509,6 @@ setMailSmtpData = do
         in tell $ mempty { smtpEnvelopeFrom = Last $ Just verp }
     | otherwise
     -> tell $ mempty { smtpEnvelopeFrom = Last $ Just from }
+
+
+derivePersistFieldJSON ''MailLanguages
diff --git a/src/Model.hs b/src/Model.hs
index 1e1ecf062..c86406275 100644
--- a/src/Model.hs
+++ b/src/Model.hs
@@ -6,7 +6,7 @@ module Model
   , module Cron.Types
   ) where
 
-import ClassyPrelude.Yesod
+import Import.NoModel
 import Database.Persist.Quasi
 import Database.Persist.TH.Directory
 -- import Data.Time
@@ -23,8 +23,6 @@ import Utils.Message (MessageStatus)
 
 import Settings.Cluster (ClusterSettingsKey)
 
-import Data.Binary (Binary)
-
 -- You can define all of your database entities in the entities file.
 -- You can find more information on persistent and how to declare entities
 -- at:
@@ -38,9 +36,5 @@ deriving instance Eq (Unique Sheet)     -- instance Eq CourseSheet
 deriving instance Eq (Unique Material)  -- instance Eq UniqueMaterial
 deriving instance Eq (Unique Tutorial)  -- instance Eq Tutorial
 
--- Primary keys mentioned in dbtable row-keys must be Binary
--- Automatically generated (i.e. numeric) ids are already taken care of
-deriving instance Binary (Key Term)
-
 submissionRatingDone :: Submission -> Bool
 submissionRatingDone Submission{..} = isJust submissionRatingTime
diff --git a/src/Model/Migration.hs b/src/Model/Migration.hs
index 6a5e36ebb..e24c93de3 100644
--- a/src/Model/Migration.hs
+++ b/src/Model/Migration.hs
@@ -79,7 +79,7 @@ migrateAll = do
 
 requiresMigration :: forall m. (MonadLogger m, MonadBaseControl IO m, MonadIO m) => ReaderT SqlBackend m Bool
 requiresMigration = mapReaderT (exceptT return return) $ do
-  initial <- getMigration initialMigration
+  initial <- either id (map snd) <$> parseMigration initialMigration
   when (not $ null initial) $ do
     $logInfoS "Migration" $ intercalate "; " initial
     throwError True
@@ -89,7 +89,7 @@ requiresMigration = mapReaderT (exceptT return return) $ do
     $logInfoS "Migration" . intercalate ", " . map tshow $ Map.keys customs
     throwError True
     
-  automatic <- getMigration migrateAll'
+  automatic <- either id (map snd) <$> parseMigration migrateAll'
   when (not $ null automatic) $ do
     $logInfoS "Migration" $ intercalate "; " automatic
     throwError True
@@ -279,8 +279,8 @@ customMigrations = Map.fromListWith (>>)
                 ( Legacy.NoSubmissions       , _                   ) -> SubmissionMode False Nothing
                 ( Legacy.CorrectorSubmissions, _                   ) -> SubmissionMode True Nothing
                 ( Legacy.UserSubmissions     , Legacy.NoUpload     ) -> SubmissionMode False (Just NoUpload)
-                ( Legacy.UserSubmissions     , Legacy.Upload True  ) -> SubmissionMode False (Just $ Upload True)
-                ( Legacy.UserSubmissions     , Legacy.Upload False ) -> SubmissionMode False (Just $ Upload False)
+                ( Legacy.UserSubmissions     , Legacy.Upload True  ) -> SubmissionMode False (Just $ UploadAny True defaultExtensionRestriction)
+                ( Legacy.UserSubmissions     , Legacy.Upload False ) -> SubmissionMode False (Just $ UploadAny False defaultExtensionRestriction)
           [executeQQ| UPDATE "sheet" SET "submission_mode" = #{submissionMode'} WHERE "id" = #{shid}; |]
     )
   , ( AppliedMigrationKey [migrationVersion|11.0.0|] [version|12.0.0|]
diff --git a/src/Model/Migration/Types.hs b/src/Model/Migration/Types.hs
index 4720bf099..e5ed53362 100644
--- a/src/Model/Migration/Types.hs
+++ b/src/Model/Migration/Types.hs
@@ -7,7 +7,7 @@ import Data.Aeson.TH (deriveJSON, defaultOptions)
 import Utils.PathPiece
 
 import qualified Model as Current
-import qualified Model.Types.JSON as Current
+import qualified Model.Types.TH.JSON as Current
 
 import Data.Universe
 
diff --git a/src/Model/Submission.hs b/src/Model/Submission.hs
index 0f931911b..24ef1bad6 100644
--- a/src/Model/Submission.hs
+++ b/src/Model/Submission.hs
@@ -7,6 +7,7 @@ data SubmissionSinkException = DuplicateFileTitle FilePath
                              | DuplicateRating
                              | RatingWithoutUpdate
                              | ForeignRating CryptoFileNameSubmission
+                             | InvalidFileTitleExtension FilePath
   deriving (Typeable, Show)
 
 instance Exception SubmissionSinkException
diff --git a/src/Model/Types.hs b/src/Model/Types.hs
index d55783fcb..a8e2fc90c 100644
--- a/src/Model/Types.hs
+++ b/src/Model/Types.hs
@@ -1,1034 +1,14 @@
-{-# LANGUAGE GeneralizedNewtypeDeriving
-           , UndecidableInstances
-  #-}
-{-# OPTIONS_GHC -fno-warn-orphans #-} -- for instance PathPiece (CI Text)
-
 module Model.Types
-  ( module Model.Types
-  , module Numeric.Natural
-  , module Mail
-  , module Utils.DateTime
-  , module Data.UUID.Types
+  ( module Types
   ) where
 
-import ClassyPrelude
-import Utils
-import Control.Lens hiding (universe)
-import Utils.Lens.TH
-
-import Data.Set (Set)
-import qualified Data.Set as Set
-import qualified Data.Map as Map
-import Data.Fixed
-import Data.Monoid (Sum(..))
-import Data.Maybe (fromJust)
-import Data.Universe
-import Data.Universe.Helpers
-import Data.Universe.TH
-import Data.UUID.Types (UUID)
-import qualified Data.UUID.Types as UUID
-
-import Data.NonNull.Instances ()
-
-import Data.Default
-
-import Text.Read (readMaybe)
-
-import Database.Persist.TH hiding (derivePersistFieldJSON)
-import Model.Types.JSON
-import Database.Persist.Class
-import Database.Persist.Sql
-
-import Web.HttpApiData
-import Web.PathPieces
-
-import Text.Blaze (Markup)
-import Data.Text (Text)
-import qualified Data.Text as Text
-import qualified Data.Text.Lens as Text
-
-import qualified Data.HashMap.Strict as HashMap
-
-import Data.CaseInsensitive (CI)
-import qualified Data.CaseInsensitive as CI
-import Data.CaseInsensitive.Instances ()
-
-import Yesod.Core.Dispatch (PathPiece(..))
-import qualified Data.Aeson as Aeson
-import qualified Data.Aeson.Types as Aeson
-import Data.Aeson (FromJSON(..), ToJSON(..), FromJSONKey(..), ToJSONKey(..), FromJSONKeyFunction(..), withText, withObject, Value())
-import Data.Aeson.Types (toJSONKeyText)
-import Data.Aeson.TH (deriveJSON, defaultOptions, Options(..), SumEncoding(..), mkToJSON, mkParseJSON)
-
-import GHC.Generics (Generic)
-import Generics.Deriving.Monoid (memptydefault, mappenddefault)
-import Data.Typeable (Typeable)
-
-import Data.Universe.Instances.Reverse ()
-
-import qualified Yesod.Auth.Util.PasswordStore as PWStore
-
-import Mail (MailLanguages(..))
-import Utils.DateTime (DateTimeFormat(..), SelDateTimeFormat(..))
-
-import Numeric.Natural
-import Data.Word.Word24 (Word24)
-import Data.Bits
-import Data.Ix
-import Data.List (genericIndex, elemIndex)
-import System.Random (Random(..))
-import Data.Data (Data)
-
-import Model.Types.Wordlist
-import Data.Text.Metrics (damerauLevenshtein)
-
-import Data.Binary (Binary)
-import qualified Data.Binary as Binary
-
-import Time.Types (WeekDay(..))
-import Data.Time.LocalTime (LocalTime, TimeOfDay)
-
-import Data.Semigroup (Min(..))
-import Control.Monad.Trans.Writer (execWriter)
-import Control.Monad.Writer.Class (MonadWriter(..))
-
-
-instance PathPiece UUID where
-  fromPathPiece = UUID.fromString . unpack
-  toPathPiece = pack . UUID.toString
-
-instance {-# OVERLAPS #-} PathMultiPiece FilePath where
-  fromPathMultiPiece = Just . unpack . intercalate "/"
-  toPathMultiPiece = Text.splitOn "/" . pack
-
-
-type Count  = Sum Integer
-type Points = Centi
-
-toPoints :: Integral a => a -> Points -- deprecated
-toPoints = fromIntegral
-
-pToI :: Points -> Integer -- deprecated
-pToI = fromPoints
-
-fromPoints :: Integral a => Points -> a -- deprecated
-fromPoints = round
-
-instance DisplayAble Points
-
-instance DisplayAble a => DisplayAble (Sum a) where
-  display (Sum x) = display x
-
-data SheetGrading
-  = Points     { maxPoints :: Points }
-  | PassPoints { maxPoints, passingPoints :: Points }
-  | PassBinary -- non-zero means passed
-  deriving (Eq, Read, Show, Generic)
-
-deriveJSON defaultOptions
-  { constructorTagModifier = camelToPathPiece
-  , fieldLabelModifier = intercalate "-" . map toLower . dropEnd 1 . splitCamel
-  , sumEncoding = TaggedObject "type" "data"
-  } ''SheetGrading
-derivePersistFieldJSON ''SheetGrading
-
-makeLenses_ ''SheetGrading
-
-_passingBound :: Fold SheetGrading (Either () Points)
-_passingBound = folding passPts
-  where
-    passPts :: SheetGrading -> Maybe (Either () Points)
-    passPts (Points{}) = Nothing
-    passPts (PassPoints{passingPoints}) = Just $ Right passingPoints
-    passPts (PassBinary) = Just $ Left ()
-
-gradingPassed :: SheetGrading -> Points -> Maybe Bool
-gradingPassed gr pts = either pBinary pPoints <$> gr ^? _passingBound
-    where pBinary _ = pts /= 0
-          pPoints b = pts >= b
-
-
-data SheetGradeSummary = SheetGradeSummary
-  { numSheets       :: Count       -- Total number of sheets, includes all
-  , numSheetsPasses :: Count       -- Number of sheets required to pass FKA: numGradePasses
-  , numSheetsPoints :: Count       -- Number of sheets having points    FKA: sumGradePointsd
-  , sumSheetsPoints :: Sum Points  -- Total of all points in all sheets
-  -- Marking dependend
-  , numMarked       :: Count       -- Number of already marked sheets
-  , numMarkedPasses :: Count       -- Number of already marked sheets with passes
-  , numMarkedPoints :: Count       -- Number of already marked sheets with points
-  , sumMarkedPoints :: Sum Points  -- Achieveable points within marked sheets
-  --
-  , achievedPasses :: Count        -- Achieved passes (within marked sheets)
-  , achievedPoints :: Sum Points   -- Achieved points (within marked sheets)
-  } deriving (Generic, Read, Show, Eq)
-
-instance Monoid SheetGradeSummary where
-  mempty  = memptydefault
-  mappend = mappenddefault
-
-instance Semigroup SheetGradeSummary where
-  (<>) = mappend -- TODO: remove for GHC > 8.4.x
-
-makeLenses_ ''SheetGradeSummary
-
-sheetGradeSum :: SheetGrading -> Maybe Points -> SheetGradeSummary
-sheetGradeSum gr Nothing  = mempty
-  { numSheets = 1
-  , numSheetsPasses = bool  mempty   1 $ has _passingBound gr
-  , numSheetsPoints = bool  mempty   1 $ has _maxPoints    gr
-  , sumSheetsPoints = maybe mempty Sum $ gr ^? _maxPoints
-  }
-sheetGradeSum gr (Just p) =
-  let unmarked@SheetGradeSummary{..} = sheetGradeSum gr Nothing
-  in  unmarked
-        { numMarked       = numSheets
-        , numMarkedPasses = numSheetsPasses
-        , numMarkedPoints = numSheetsPoints
-        , sumMarkedPoints = sumSheetsPoints
-        , achievedPasses  = fromMaybe mempty $ bool 0 1 <$> gradingPassed gr p
-        , achievedPoints  = bool mempty (Sum p) $ has _maxPoints gr
-        }
-
-
-data SheetType
-  = NotGraded
-  | Normal        { grading :: SheetGrading }
-  | Bonus         { grading :: SheetGrading }
-  | Informational { grading :: SheetGrading }
-  deriving (Eq, Read, Show, Generic)
-
-deriveJSON defaultOptions
-  { constructorTagModifier = camelToPathPiece
-  , fieldLabelModifier = camelToPathPiece
-  , sumEncoding = TaggedObject "type" "data"
-  } ''SheetType
-derivePersistFieldJSON ''SheetType
-
-data SheetTypeSummary = SheetTypeSummary
-  { normalSummary
-  , bonusSummary
-  , informationalSummary :: SheetGradeSummary
-  , numNotGraded :: Count
-  } deriving (Generic, Read, Show, Eq)
-
-instance Monoid SheetTypeSummary where
-  mempty  = memptydefault
-  mappend = mappenddefault
-
-instance Semigroup SheetTypeSummary where
-  (<>) = mappend -- TODO: remove for GHC > 8.4.x
-
-makeLenses_ ''SheetTypeSummary
-
-sheetTypeSum :: SheetType -> Maybe Points -> SheetTypeSummary
-sheetTypeSum Bonus{..}         mps = mempty { bonusSummary         = sheetGradeSum grading mps }
-sheetTypeSum Normal{..}        mps = mempty { normalSummary        = sheetGradeSum grading mps }
-sheetTypeSum Informational{..} mps = mempty { informationalSummary = sheetGradeSum grading mps }
-sheetTypeSum NotGraded _           = mempty { numNotGraded         = Sum 1 }
-
-data SheetGroup
-  = Arbitrary { maxParticipants :: Natural }
-  | RegisteredGroups
-  | NoGroups
-  deriving (Show, Read, Eq, Generic)
-deriveJSON defaultOptions ''SheetGroup
-derivePersistFieldJSON ''SheetGroup
-
-makeLenses_ ''SheetGroup
-
-data SheetFileType = SheetExercise | SheetHint | SheetSolution | SheetMarking
-  deriving (Show, Read, Eq, Ord, Enum, Bounded, Generic)
-derivePersistField "SheetFileType"
-
-instance Universe SheetFileType where universe = universeDef
-instance Finite SheetFileType
-
-instance PathPiece SheetFileType where
-  toPathPiece SheetExercise = "file"
-  toPathPiece SheetHint     = "hint"
-  toPathPiece SheetSolution = "solution"
-  toPathPiece SheetMarking  = "marking"
-  fromPathPiece = finiteFromPathPiece
-
-sheetFile2markup :: SheetFileType -> Markup
-sheetFile2markup SheetExercise = iconQuestion
-sheetFile2markup SheetHint     = iconHint
-sheetFile2markup SheetSolution = iconSolution
-sheetFile2markup SheetMarking  = iconMarking
-
--- $(deriveSimpleWith ''DisplayAble 'display (drop 17) ''SheetFileType)
-instance DisplayAble SheetFileType where -- deprecated, see RenderMessage instance in Foundation
-  display SheetExercise = "Aufgabenstellung"
-  display SheetHint     = "Hinweise"
-  display SheetSolution = "Musterlösung"
-  display SheetMarking  = "Korrekturhinweise"
-
--- partitionFileType' :: Ord a => [(SheetFileType,a)] -> Map SheetFileType (Set a)
--- partitionFileType' = groupMap
-
-partitionFileType :: Ord a => [(SheetFileType,a)] -> SheetFileType -> Set a
-partitionFileType fs t = Map.findWithDefault Set.empty t . Map.fromListWith Set.union $ map (over _2 Set.singleton) fs
-
-data SubmissionFileType = SubmissionOriginal | SubmissionCorrected
-  deriving (Show, Read, Eq, Ord, Enum, Bounded, Generic)
-
-instance Universe SubmissionFileType where universe = universeDef
-instance Finite SubmissionFileType
-
-submissionFileTypeIsUpdate :: SubmissionFileType -> Bool
-submissionFileTypeIsUpdate SubmissionOriginal  = False
-submissionFileTypeIsUpdate SubmissionCorrected = True
-
-isUpdateSubmissionFileType :: Bool -> SubmissionFileType
-isUpdateSubmissionFileType False = SubmissionOriginal
-isUpdateSubmissionFileType True  = SubmissionCorrected
-
-instance PathPiece SubmissionFileType where
-  toPathPiece SubmissionOriginal  = "original"
-  toPathPiece SubmissionCorrected = "corrected"
-  fromPathPiece = finiteFromPathPiece
-
-instance DisplayAble SubmissionFileType where
-  display SubmissionOriginal  = "Abgabe"
-  display SubmissionCorrected = "Korrektur"
-
-{-
-data DA = forall a . (DisplayAble a) => DA a
-
-instance DisplayAble DA where
-  display (DA x) = display x
--}
-
-
-data UploadMode = NoUpload | Upload { unpackZips :: Bool }
-  deriving (Show, Read, Eq, Ord, Generic)
-
-deriveFinite ''UploadMode
-
-deriveJSON defaultOptions
-  { constructorTagModifier = camelToPathPiece
-  , fieldLabelModifier = camelToPathPiece
-  , sumEncoding = TaggedObject "mode" "settings"
-  }''UploadMode
-derivePersistFieldJSON ''UploadMode
-
-instance PathPiece UploadMode where
-  toPathPiece = \case
-    NoUpload     -> "no-upload"
-    Upload True  -> "unpack"
-    Upload False -> "no-unpack"
-  fromPathPiece = finiteFromPathPiece
-
-data SubmissionMode = SubmissionMode
-  { submissionModeCorrector :: Bool
-  , submissionModeUser :: Maybe UploadMode
-  }
-  deriving (Show, Read, Eq, Ord, Generic)
-
-deriveFinite ''SubmissionMode
-
-deriveJSON defaultOptions
-  { fieldLabelModifier = camelToPathPiece' 2
-  } ''SubmissionMode
-derivePersistFieldJSON ''SubmissionMode
-
-finitePathPiece ''SubmissionMode
-  [ "no-submissions"
-  , "no-upload"
-  , "no-unpack"
-  , "unpack"
-  , "correctors"
-  , "correctors+no-upload"
-  , "correctors+no-unpack"
-  , "correctors+unpack"
-  ]
-
-data SubmissionModeDescr = SubmissionModeNone
-                         | SubmissionModeCorrector
-                         | SubmissionModeUser
-                         | SubmissionModeBoth
-  deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable)
-instance Universe SubmissionModeDescr
-instance Finite SubmissionModeDescr
-
-finitePathPiece ''SubmissionModeDescr
-  [ "no-submissions"
-  , "correctors"
-  , "users"
-  , "correctors+users"
-  ]
-
-classifySubmissionMode :: SubmissionMode -> SubmissionModeDescr
-classifySubmissionMode (SubmissionMode False Nothing ) = SubmissionModeNone
-classifySubmissionMode (SubmissionMode True  Nothing ) = SubmissionModeCorrector
-classifySubmissionMode (SubmissionMode False (Just _)) = SubmissionModeUser
-classifySubmissionMode (SubmissionMode True  (Just _)) = SubmissionModeBoth
-
-
-data ExamPartResult = ExamAttended { examPartResult :: Maybe Points }
-                    | ExamNoShow
-                    | ExamVoided
-  deriving (Show, Read, Eq, Ord, Generic, Typeable)
-deriveJSON defaultOptions
-  { constructorTagModifier = camelToPathPiece' 1
-  , fieldLabelModifier = camelToPathPiece' 2
-  , omitNothingFields = True
-  , sumEncoding = TaggedObject "status" "result"
-  } ''ExamPartResult
-derivePersistFieldJSON ''ExamPartResult
-
-data ExamBonusRule = ExamNoBonus
-                   | ExamBonusPoints
-                     { bonusExchangeRate :: Rational
-                     , bonusOnlyPassed :: Bool
-                     }
-  deriving (Show, Read, Eq, Ord, Generic, Typeable)
-deriveJSON defaultOptions
-  { constructorTagModifier = camelToPathPiece' 1
-  , fieldLabelModifier = camelToPathPiece' 1
-  , sumEncoding = TaggedObject "rule" "settings"
-  } ''ExamBonusRule
-derivePersistFieldJSON ''ExamBonusRule
-
-data ExamOccuranceRule = ExamRoomManual
-                       | ExamRoomSurname
-                       | ExamRoomMatriculation
-                       | ExamRoomRandom
-  deriving (Show, Read, Eq, Ord, Generic, Typeable)
-deriveJSON defaultOptions
-  { constructorTagModifier = camelToPathPiece' 2
-  , fieldLabelModifier = camelToPathPiece' 1
-  , sumEncoding = TaggedObject "rule" "settings"
-  } ''ExamOccuranceRule
-derivePersistFieldJSON ''ExamOccuranceRule
-
--- | Specify a corrector's workload
-data Load -- = ByTutorial { countsToLoad :: Bool } | ByProportion { load :: Rational }
-    = Load { byTutorial :: Maybe Bool  -- ^ @Just@ all from Tutorial, @True@ if counting towards overall workload
-           , byProportion :: Rational  -- ^ workload proportion of all submission not assigned to tutorial leaders
-           }
-  deriving (Show, Read, Eq, Ord, Generic)
-
-deriveJSON defaultOptions ''Load
-derivePersistFieldJSON ''Load
-
-instance Hashable Load
-
-instance Semigroup Load where
-  (Load byTut prop) <> (Load byTut' prop') = Load byTut'' (prop + prop')
-    where
-      byTut''
-        | Nothing <- byTut  = byTut'
-        | Nothing <- byTut' = byTut
-        | Just a <- byTut
-        , Just b <- byTut'  = Just $ a || b
-
-instance Monoid Load where
-  mempty = Load Nothing 0
-  mappend = (<>)
-
-{- Use (is _ByTutorial) instead of this unneeded definition:
-  isByTutorial :: Load -> Bool
-  isByTutorial (ByTutorial {}) = True
-  isByTutorial _               = False
--}
-
-data Season = Summer | Winter
-  deriving (Show, Read, Eq, Ord, Enum, Bounded, Generic, Typeable)
-
-instance Binary Season
-
-seasonToChar :: Season -> Char
-seasonToChar Summer = 'S'
-seasonToChar Winter = 'W'
-
-seasonFromChar :: Char -> Either Text Season
-seasonFromChar c
-  | c ~= 'S'  = Right Summer
-  | c ~= 'W'  = Right Winter
-  | otherwise = Left $ "Invalid season character: ‘" <> tshow c <> "’"
-  where
-    (~=) = (==) `on` CI.mk
-
-instance DisplayAble Season
-
-data TermIdentifier = TermIdentifier
-  { year :: Integer -- ^ Using 'Integer' to model years is consistent with 'Data.Time.Calendar'
-  , season :: Season
-  } deriving (Show, Read, Eq, Ord, Generic, Typeable)
-
-instance Binary TermIdentifier
-
-instance Enum TermIdentifier where
-  -- ^ Do not use for conversion – Enumeration only
-  toEnum int = let (toInteger -> year, toEnum -> season) = int `divMod` 2 in TermIdentifier{..}
-  fromEnum TermIdentifier{..} = fromInteger year * 2 + fromEnum season
-
--- Conversion TermId <-> TermIdentifier::
--- from_TermId_to_TermIdentifier = unTermKey
--- from_TermIdentifier_to_TermId = TermKey
-
-shortened :: Iso' Integer Integer
-shortened = iso shorten expand
-  where
-    century = ($currentYear `div` 100) * 100
-    expand year
-      | 0 <= year
-      , year < 100 = let
-          options = [ expanded | offset <- [-1, 0, 1]
-                               , let century' = century + offset * 100
-                                     expanded = century' + year
-                               , $currentYear - 50 <= expanded
-                               , expanded < $currentYear + 50
-                               ]
-          in case options of
-               [unique] -> unique
-               failed   -> error $ "Could not expand year " ++ show year ++ ": " ++ show failed
-      | otherwise = year
-    shorten year
-      | $currentYear - 50 <= year
-      , year < $currentYear + 50 = year `mod` 100
-      | otherwise = year
-
-termToText :: TermIdentifier -> Text
-termToText TermIdentifier{..} = Text.pack $ seasonToChar season : show (year ^. shortened)
-
--- also see Hander.Utils.tidFromText
-termFromText :: Text -> Either Text TermIdentifier
-termFromText t
-  | (s:ys) <- Text.unpack t
-  , Just (review shortened -> year) <- readMaybe ys
-  , Right season <- seasonFromChar s
-  = Right TermIdentifier{..}
-  | otherwise = Left $ "Invalid TermIdentifier: “" <> t <> "”" -- TODO: Could be improved, I.e. say "W"/"S" from Number
-
-termToRational :: TermIdentifier -> Rational
-termToRational TermIdentifier{..} = fromInteger year + seasonOffset
-  where
-    seasonOffset
-      | Summer <- season = 0
-      | Winter <- season = 0.5
-
-termFromRational :: Rational -> TermIdentifier
-termFromRational n = TermIdentifier{..}
-  where
-    year = floor n
-    remainder = n - (fromInteger $ floor n)
-    season
-      | remainder == 0 = Summer
-      | otherwise      = Winter
-
-instance PersistField TermIdentifier where
-  toPersistValue = PersistRational . termToRational
-  fromPersistValue (PersistRational t) = Right $ termFromRational t
-  fromPersistValue x = Left $ "Expected TermIdentifier, received: " <> tshow x
-
-instance PersistFieldSql TermIdentifier where
-  sqlType _ = SqlNumeric 5 1
-
-instance ToHttpApiData TermIdentifier where
-  toUrlPiece = termToText
-
-instance FromHttpApiData TermIdentifier where
-  parseUrlPiece = termFromText
-
-instance PathPiece TermIdentifier where
-  fromPathPiece = either (const Nothing) Just . termFromText
-  toPathPiece = termToText
-
-instance ToJSON TermIdentifier where
-  toJSON = Aeson.String . termToText
-
-instance FromJSON TermIdentifier where
-  parseJSON = withText "Term" $ either (fail . Text.unpack) return . termFromText
-
-{- Must be defined in a later module:
-    termField :: Field (HandlerT UniWorX IO) TermIdentifier
-    termField = checkMMap (return . termFromText) termToText textField
-   See Handler.Utils.Form.termsField and termActiveField
--}
-
-
-withinTerm :: Day -> TermIdentifier -> Bool
-time `withinTerm` term = timeYear `mod` 100 == termYear `mod` 100
-  where
-    timeYear = fst3 $ toGregorian time
-    termYear = year term
-
-
-data StudyFieldType = FieldPrimary | FieldSecondary
-  deriving (Eq, Ord, Enum, Show, Read, Bounded, Generic)
-derivePersistField "StudyFieldType"
-
-instance PersistField UUID where
-  toPersistValue = PersistDbSpecific . UUID.toASCIIBytes
-  fromPersistValue (PersistText t) = maybe (Left "Failed to parse UUID") Right $ UUID.fromText t
-  fromPersistValue (PersistByteString bs) = maybe (Left "Failed to parse UUID") Right $ UUID.fromASCIIBytes bs
-  fromPersistValue (PersistDbSpecific bs) = maybe (Left "Failed to parse UUID") Right $ UUID.fromASCIIBytes bs
-  fromPersistValue x = Left $ "Expected UUID, received: " <> tshow x
-
-instance PersistFieldSql UUID where
-  sqlType _ = SqlOther "uuid"
-
-instance DisplayAble StudyFieldType
-
-data Theme
-  = ThemeDefault
-  | ThemeLavender
-  | ThemeNeutralBlue
-  | ThemeAberdeenReds
-  | ThemeMossGreen
-  | ThemeSkyLove
-  deriving (Eq, Ord, Bounded, Enum, Show, Read, Generic)
-
-deriveJSON defaultOptions
-  { constructorTagModifier = fromJust . stripPrefix "Theme"
-  } ''Theme
-
-instance Universe Theme where universe = universeDef
-instance Finite Theme
-
-nullaryPathPiece ''Theme (camelToPathPiece' 1)
-
-$(deriveSimpleWith ''DisplayAble 'display (over Text.packed $ Text.intercalate " " . unsafeTail . splitCamel) ''Theme) -- describe theme to user
-
-derivePersistField "Theme"
-
-
-newtype ZIPArchiveName obj = ZIPArchiveName { unZIPArchiveName :: obj }
-  deriving (Show, Read, Eq, Ord, Generic, Typeable)
-
-instance PathPiece obj => PathPiece (ZIPArchiveName obj) where
-    fromPathPiece = fmap ZIPArchiveName . fromPathPiece <=< (stripSuffix `on` CI.foldCase) ".zip"
-    toPathPiece = (<> ".zip") . toPathPiece . unZIPArchiveName
-
-
-data CorrectorState = CorrectorNormal | CorrectorMissing | CorrectorExcused
-  deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic)
-
-deriveJSON defaultOptions
-  { constructorTagModifier = fromJust . stripPrefix "Corrector"
-  } ''CorrectorState
-
-instance Universe CorrectorState
-instance Finite CorrectorState
-
-instance Hashable CorrectorState
-
-nullaryPathPiece ''CorrectorState (camelToPathPiece' 1)
-
-derivePersistField "CorrectorState"
-
-
-data AuthenticationMode = AuthLDAP
-                        | AuthPWHash { authPWHash :: Text }
-  deriving (Eq, Ord, Read, Show, Generic)
-
-deriveJSON defaultOptions
-  { constructorTagModifier = intercalate "-" . map toLower . drop 1 . splitCamel
-  , fieldLabelModifier = intercalate "-" . map toLower . drop 1 . splitCamel
-  , sumEncoding = UntaggedValue
-  } ''AuthenticationMode
-
-derivePersistFieldJSON ''AuthenticationMode
-
-
-derivePersistFieldJSON ''Value
-
-
--- ^ `NotificationSettings` is for now a series of boolean checkboxes, i.e. a mapping @NotificationTrigger -> Bool@
---
--- Could maybe be replaced with `Structure Notification` in the long term
-data NotificationTrigger = NTSubmissionRatedGraded
-                         | NTSubmissionRated
-                         | NTSheetActive
-                         | NTSheetSoonInactive
-                         | NTSheetInactive
-                         | NTCorrectionsAssigned
-                         | NTCorrectionsNotDistributed
-                         | NTUserRightsUpdate
-  deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable)
-
-instance Universe NotificationTrigger
-instance Finite NotificationTrigger
-
-instance Hashable NotificationTrigger
-
-deriveJSON defaultOptions
-  { constructorTagModifier = intercalate "-" . map toLower . drop 1 . splitCamel
-  } ''NotificationTrigger
-
-instance ToJSONKey NotificationTrigger where
-  toJSONKey = toJSONKeyText $ \v -> let Aeson.String t = toJSON v in t
-
-instance FromJSONKey NotificationTrigger where
-  fromJSONKey = FromJSONKeyTextParser $ parseJSON . Aeson.String
-
-
-newtype NotificationSettings = NotificationSettings { notificationAllowed :: NotificationTrigger -> Bool }
-  deriving (Generic, Typeable)
-  deriving newtype (Eq, Ord, Read, Show)
-
-instance Default NotificationSettings where
-  def = NotificationSettings $ \case
-    NTSubmissionRatedGraded -> True
-    NTSubmissionRated -> False
-    NTSheetActive -> True
-    NTSheetSoonInactive -> False
-    NTSheetInactive -> True
-    NTCorrectionsAssigned -> True
-    NTCorrectionsNotDistributed -> True
-    NTUserRightsUpdate -> True
-
-instance ToJSON NotificationSettings where
-  toJSON v = toJSON . HashMap.fromList $ map (id &&& notificationAllowed v) universeF
-
-instance FromJSON NotificationSettings where
-  parseJSON = withObject "NotificationSettings" $ \o -> do
-    o' <- parseJSON $ Aeson.Object o :: Aeson.Parser (HashMap NotificationTrigger Bool)
-    return . NotificationSettings $ \n -> case HashMap.lookup n o' of
-      Nothing -> notificationAllowed def n
-      Just b  -> b
-
-derivePersistFieldJSON ''NotificationSettings
-
-
-instance ToBackendKey SqlBackend record => Hashable (Key record) where
-  hashWithSalt s key = s `hashWithSalt` fromSqlKey key
-
-derivePersistFieldJSON ''MailLanguages
-
-
-type PseudonymWord   = CI Text
-
-newtype Pseudonym = Pseudonym Word24
-  deriving (Eq, Ord, Read, Show, Generic, Data)
-  deriving newtype (Bounded, Enum, Integral, Num, Real, Ix)
-
-
-instance PersistField Pseudonym where
-  toPersistValue p = toPersistValue (fromIntegral p :: Word32)
-  fromPersistValue v = do
-    w <- fromPersistValue v :: Either Text Word32
-    if
-      | 0 <= w
-      , w <= fromIntegral (maxBound :: Pseudonym)
-        -> return $ fromIntegral w
-      | otherwise
-        -> Left "Pseudonym out of range"
-
-instance PersistFieldSql Pseudonym where
-  sqlType _ = SqlInt32
-
-instance Random Pseudonym where
-  randomR (max minBound -> lo, min maxBound -> hi) gen = over _1 (fromIntegral :: Word32 -> Pseudonym) $ randomR (fromIntegral lo, fromIntegral hi) gen
-  random = randomR (minBound, maxBound)
-
-instance FromJSON Pseudonym where
-  parseJSON v@(Aeson.Number _) = do
-    w <- parseJSON v :: Aeson.Parser Word32
-    if
-      | 0 <= w
-      , w <= fromIntegral (maxBound :: Pseudonym)
-        -> return $ fromIntegral w
-      | otherwise
-        -> fail "Pseudonym out auf range"
-  parseJSON (Aeson.String t)
-    = case t ^? _PseudonymText of
-        Just p -> return p
-        Nothing -> fail "Could not parse pseudonym"
-  parseJSON v = flip (Aeson.withArray "Pseudonym") v $ \ws -> do
-    ws' <- toList . map CI.mk <$> mapM parseJSON ws
-    case ws' ^? _PseudonymWords of
-      Just p -> return p
-      Nothing -> fail "Could not parse pseudonym words"
-
-instance ToJSON Pseudonym where
-  toJSON = toJSON . (review _PseudonymWords :: Pseudonym -> [PseudonymWord])
-
-pseudonymWordlist :: [PseudonymWord]
-pseudonymCharacters :: Set (CI Char)
-(pseudonymWordlist, pseudonymCharacters) = $(wordlist "config/wordlist.txt")
-
-_PseudonymWords :: Prism' [PseudonymWord] Pseudonym
-_PseudonymWords = prism' pToWords pFromWords
-  where
-    pFromWords :: [PseudonymWord] -> Maybe Pseudonym
-    pFromWords [w1, w2]
-      | Just i1 <- elemIndex w1 pseudonymWordlist
-      , Just i2 <- elemIndex w2 pseudonymWordlist
-      , i1 <= maxWord, i2 <= maxWord
-      = Just . Pseudonym $ shiftL (fromIntegral i1) 12 .|. fromIntegral i2
-    pFromWords _ = Nothing
-
-    pToWords :: Pseudonym -> [PseudonymWord]
-    pToWords (Pseudonym p)
-      = [ genericIndex pseudonymWordlist $ shiftR p 12 .&. maxWord
-        , genericIndex pseudonymWordlist $ p .&. maxWord
-        ]
-
-    maxWord :: Num a => a
-    maxWord = 0b111111111111
-
-_PseudonymText :: Prism' Text Pseudonym
-_PseudonymText = prism' tToWords tFromWords . _PseudonymWords
-  where
-    tFromWords :: Text -> Maybe [PseudonymWord]
-    tFromWords input
-      | [result] <- input ^.. pseudonymFragments
-      = Just result
-      | otherwise
-      = Nothing
-
-    tToWords :: [PseudonymWord] -> Text
-    tToWords = Text.unwords . map CI.original
-
-pseudonymWords :: Fold Text PseudonymWord
-pseudonymWords = folding
-  $ \(CI.mk -> input) -> map (view _2) . fromMaybe [] . listToMaybe . groupBy ((==) `on` view _1) . sortBy (comparing $ view _1) . filter ((<= distanceCutoff) . view _1) $ map (distance input &&& id) pseudonymWordlist
-  where
-    distance = damerauLevenshtein `on` CI.foldedCase
-    -- | Arbitrary cutoff point, for reference: ispell cuts off at 1
-    distanceCutoff = 2
-
-pseudonymFragments :: Fold Text [PseudonymWord]
-pseudonymFragments = folding
-  $ mapM (toListOf pseudonymWords) . (\l -> guard (length l == 2) *> l) . filter (not . null) . Text.split (\(CI.mk -> c) -> not $ Set.member c pseudonymCharacters)
-
-
-data AuthTag -- sortiert nach gewünschter Reihenfolge auf /authpreds, d.h. Prädikate sind sortier nach Relevanz für Benutzer
-  = AuthAdmin
-  | AuthLecturer
-  | AuthCorrector
-  | AuthTutor
-  | AuthCourseRegistered
-  | AuthTutorialRegistered
-  | AuthParticipant
-  | AuthTime
-  | AuthMaterials
-  | AuthOwner
-  | AuthRated
-  | AuthUserSubmissions
-  | AuthCorrectorSubmissions
-  | AuthCapacity
-  | AuthRegisterGroup
-  | AuthEmpty
-  | AuthSelf
-  | AuthAuthentication
-  | AuthNoEscalation
-  | AuthRead
-  | AuthWrite
-  | AuthToken
-  | AuthDeprecated
-  | AuthDevelopment
-  | AuthFree
-  deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic, Typeable)
-
-instance Universe AuthTag
-instance Finite AuthTag
-instance Hashable AuthTag
-
-deriveJSON defaultOptions
-  { constructorTagModifier = camelToPathPiece' 1
-  } ''AuthTag
-
-nullaryPathPiece ''AuthTag (camelToPathPiece' 1)
-
-instance ToJSONKey AuthTag where
-  toJSONKey = toJSONKeyText $ \v -> let Aeson.String t = toJSON v in t
-
-instance FromJSONKey AuthTag where
-  fromJSONKey = FromJSONKeyTextParser $ parseJSON . Aeson.String
-
-instance Binary AuthTag
-
-
-newtype AuthTagActive = AuthTagActive { authTagIsActive :: AuthTag -> Bool }
-  deriving (Read, Show, Generic)
-  deriving newtype (Eq, Ord)
-
-instance Default AuthTagActive where
-  def = AuthTagActive $ \case
-    AuthAdmin -> False
-    _ -> True
-
-instance ToJSON AuthTagActive where
-  toJSON v = toJSON . HashMap.fromList $ map (id &&& authTagIsActive v) universeF
-
-instance FromJSON AuthTagActive where
-  parseJSON = withObject "AuthTagActive" $ \o -> do
-    o' <- parseJSON $ Aeson.Object o :: Aeson.Parser (HashMap AuthTag Bool)
-    return . AuthTagActive $ \n -> case HashMap.lookup n o' of
-      Nothing -> authTagIsActive def n
-      Just b  -> b
-
-derivePersistFieldJSON ''AuthTagActive
-
-
-data PredLiteral a = PLVariable { plVar :: a } | PLNegated { plVar :: a }
-  deriving (Eq, Ord, Read, Show, Generic, Typeable)
-
-instance Hashable a => Hashable (PredLiteral a)
-deriveJSON defaultOptions
-  { constructorTagModifier = camelToPathPiece' 1
-  , sumEncoding = TaggedObject "val" "var"
-  } ''PredLiteral
-
-instance PathPiece a => PathPiece (PredLiteral a) where
-  toPathPiece PLVariable{..} = toPathPiece plVar
-  toPathPiece PLNegated{..} = "¬" <> toPathPiece plVar
-
-  fromPathPiece t = PLVariable <$> fromPathPiece t
-                <|> PLNegated <$> (Text.stripPrefix "¬" t >>= fromPathPiece)
-
-instance Binary a => Binary (PredLiteral a)
-
-
-newtype PredDNF a = PredDNF { dnfTerms :: Set (NonNull (Set (PredLiteral a))) }
-  deriving (Eq, Ord, Read, Show, Generic, Typeable)
-  deriving newtype (Semigroup, Monoid)
-
-$(return [])
-
-instance ToJSON a => ToJSON (PredDNF a) where
-  toJSON = $(mkToJSON predNFAesonOptions ''PredDNF)
-instance (Ord a, FromJSON a) => FromJSON (PredDNF a) where
-  parseJSON = $(mkParseJSON predNFAesonOptions ''PredDNF)
-
-instance (Ord a, Binary a) => Binary (PredDNF a) where
-  get = PredDNF <$> Binary.get
-  put = Binary.put . dnfTerms
-
-type AuthLiteral = PredLiteral AuthTag
-
-type AuthDNF = PredDNF AuthTag
-
-
-data LecturerType = CourseLecturer | CourseAssistant
-  deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable)
-
-instance Universe LecturerType
-instance Finite LecturerType
-
-nullaryPathPiece ''LecturerType $ camelToPathPiece' 1
-deriveJSON  defaultOptions
-  { constructorTagModifier = camelToPathPiece' 1
-  } ''LecturerType
-derivePersistFieldJSON ''LecturerType
-
-instance Hashable LecturerType
-
-
-deriveJSON defaultOptions
-  { constructorTagModifier = camelToPathPiece
-  } ''WeekDay
-
-data OccurenceSchedule = ScheduleWeekly
-                         { scheduleDayOfWeek :: WeekDay
-                         , scheduleStart     :: TimeOfDay
-                         , scheduleEnd       :: TimeOfDay
-                         }
-  deriving (Eq, Ord, Read, Show, Generic, Typeable)
-
-deriveJSON defaultOptions
-  { fieldLabelModifier = camelToPathPiece' 1
-  , constructorTagModifier = camelToPathPiece' 1
-  , tagSingleConstructors = True
-  , sumEncoding = TaggedObject "repeat" "schedule"
-  } ''OccurenceSchedule
-
-data OccurenceException = ExceptOccur
-                          { exceptDay   :: Day
-                          , exceptStart :: TimeOfDay
-                          , exceptEnd   :: TimeOfDay
-                          }
-                        | ExceptNoOccur
-                          { exceptTime  :: LocalTime
-                          }
-  deriving (Eq, Ord, Read, Show, Generic, Typeable)
-
-deriveJSON defaultOptions
-  { fieldLabelModifier = camelToPathPiece' 1
-  , constructorTagModifier = camelToPathPiece' 1
-  , sumEncoding = TaggedObject "exception" "for"
-  } ''OccurenceException
-
-data Occurences = Occurences
-  { occurencesScheduled  :: Set OccurenceSchedule
-  , occurencesExceptions :: Set OccurenceException
-  } deriving (Eq, Ord, Read, Show, Generic, Typeable)
-
-deriveJSON defaultOptions
-  { fieldLabelModifier = camelToPathPiece' 1
-  } ''Occurences
-derivePersistFieldJSON ''Occurences
-
-
-data HealthReport = HealthReport
-  { healthMatchingClusterConfig :: Bool
-    -- ^ Is the database-stored configuration we're running under still up to date?
-  , healthHTTPReachable :: Maybe Bool
-    -- ^ Can we reach a uni2work-instance with the same `ClusterId` under our configured `approot` via HTTP?
-    --
-    -- Can be `Nothing` if we don't have a static configuration setting `appRoot` or if check is disabled in settings
-  , healthLDAPAdmins :: Maybe Rational
-    -- ^ Proportion of school admins that could be found in LDAP
-    --
-    -- Is `Nothing` if LDAP is not configured or no users are school admins
-  , healthSMTPConnect :: Maybe Bool
-    -- ^ Can we connect to the SMTP server and say @NOOP@?
-  , healthWidgetMemcached :: Maybe Bool
-    -- ^ Can we store values in memcached and retrieve them via HTTP?
-  } deriving (Eq, Ord, Read, Show, Generic, Typeable)
-
-deriveJSON defaultOptions
-  { fieldLabelModifier = camelToPathPiece' 1
-  , omitNothingFields  = True
-  } ''HealthReport
-
--- | `HealthReport` classified (`classifyHealthReport`) by badness
---
--- > a < b = a `worseThan` b
---
--- Currently all consumers of this type check for @(== HealthSuccess)@; this
--- needs to be adjusted on a case-by-case basis if new constructors are added
-data HealthStatus = HealthFailure | HealthSuccess
-  deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable)
-
-instance Universe HealthStatus
-instance Finite HealthStatus
-
-deriveJSON defaultOptions
-  { constructorTagModifier = camelToPathPiece' 1
-  } ''HealthStatus
-nullaryPathPiece ''HealthStatus $ camelToPathPiece' 1
-
-classifyHealthReport :: HealthReport -> HealthStatus
--- ^ Classify `HealthReport` by badness
-classifyHealthReport HealthReport{..} = getMin . execWriter $ do -- Construction with `Writer (Min HealthStatus) a` returns worst `HealthStatus` passed to `tell` at any point
-  unless healthMatchingClusterConfig . tell $ Min HealthFailure
-  unless (fromMaybe True healthHTTPReachable) . tell $ Min HealthFailure
-  unless (maybe True (> 0) healthLDAPAdmins) . tell $ Min HealthFailure
-  unless (fromMaybe True healthSMTPConnect) . tell $ Min HealthFailure
-  unless (fromMaybe True healthWidgetMemcached) . tell $ Min HealthFailure
-
-
--- Type synonyms
-
-type Email           = Text
-
-type SchoolName      = CI Text
-type SchoolShorthand = CI Text
-type CourseName      = CI Text
-type CourseShorthand = CI Text
-type SheetName       = CI Text
-type MaterialName    = CI Text
-type UserEmail       = CI Email
-type TutorialName    = CI Text
-
-type PWHashAlgorithm = ByteString -> PWStore.Salt -> Int -> ByteString
-type InstanceId      = UUID
-type ClusterId       = UUID
-type TokenId         = UUID
-type TermCandidateIncidence = UUID
+import Model.Types.Common as Types
+import Model.Types.Course as Types
+import Model.Types.DateTime as Types
+import Model.Types.Exam as Types
+import Model.Types.Health as Types
+import Model.Types.Mail as Types
+import Model.Types.Security as Types
+import Model.Types.Sheet as Types
+import Model.Types.Submission as Types
+import Model.Types.Misc as Types
diff --git a/src/Model/Types/Common.hs b/src/Model/Types/Common.hs
new file mode 100644
index 000000000..5ffbcfb07
--- /dev/null
+++ b/src/Model/Types/Common.hs
@@ -0,0 +1,35 @@
+{-|
+Module: Model.Types.Common
+Description: Common types used by most @Model.Types.*@-Modules
+
+Types used by multiple other @Model.Types.*@-Modules
+-}
+module Model.Types.Common
+  ( module Model.Types.Common
+  ) where
+
+import Import.NoModel
+
+import qualified Yesod.Auth.Util.PasswordStore as PWStore
+  
+
+type Count  = Sum Integer
+type Points = Centi
+
+
+type Email           = Text
+
+type SchoolName      = CI Text
+type SchoolShorthand = CI Text
+type CourseName      = CI Text
+type CourseShorthand = CI Text
+type SheetName       = CI Text
+type MaterialName    = CI Text
+type UserEmail       = CI Email
+type TutorialName    = CI Text
+
+type PWHashAlgorithm = ByteString -> PWStore.Salt -> Int -> ByteString
+type InstanceId      = UUID
+type ClusterId       = UUID
+type TokenId         = UUID
+type TermCandidateIncidence = UUID
diff --git a/src/Model/Types/Course.hs b/src/Model/Types/Course.hs
new file mode 100644
index 000000000..4a1a08b3c
--- /dev/null
+++ b/src/Model/Types/Course.hs
@@ -0,0 +1,26 @@
+{-|
+Module: Model.Types.Course
+Description: Types for modeling Courses
+
+Also see `Model.Types.Sheet`
+-}
+module Model.Types.Course
+  ( module Model.Types.Course
+  ) where
+
+import Import.NoModel
+
+
+data LecturerType = CourseLecturer | CourseAssistant
+  deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable)
+
+instance Universe LecturerType
+instance Finite LecturerType
+
+nullaryPathPiece ''LecturerType $ camelToPathPiece' 1
+deriveJSON  defaultOptions
+  { constructorTagModifier = camelToPathPiece' 1
+  } ''LecturerType
+derivePersistFieldJSON ''LecturerType
+
+instance Hashable LecturerType
diff --git a/src/Model/Types/DateTime.hs b/src/Model/Types/DateTime.hs
new file mode 100644
index 000000000..10783550e
--- /dev/null
+++ b/src/Model/Types/DateTime.hs
@@ -0,0 +1,194 @@
+{-|
+Module: Model.Types.DateTime
+Description: Time related types
+
+Terms, Seasons, and Occurence schedules
+-}
+module Model.Types.DateTime
+  ( module Model.Types.DateTime
+  ) where
+
+import Import.NoModel
+import Control.Lens
+
+import qualified Data.Text as Text
+import qualified Data.CaseInsensitive as CI
+import Text.Read (readMaybe)
+
+import Database.Persist.Sql
+
+import Web.HttpApiData
+
+import Data.Aeson.Types as Aeson
+
+import Time.Types (WeekDay(..))
+import Data.Time.LocalTime (LocalTime, TimeOfDay)
+
+
+----
+--  Terms, Seaons, anything loosely related to time
+
+data Season = Summer | Winter
+  deriving (Show, Read, Eq, Ord, Enum, Bounded, Generic, Typeable)
+
+instance Binary Season
+
+seasonToChar :: Season -> Char
+seasonToChar Summer = 'S'
+seasonToChar Winter = 'W'
+
+seasonFromChar :: Char -> Either Text Season
+seasonFromChar c
+  | c ~= 'S'  = Right Summer
+  | c ~= 'W'  = Right Winter
+  | otherwise = Left $ "Invalid season character: ‘" <> tshow c <> "’"
+  where
+    (~=) = (==) `on` CI.mk
+
+-- instance DisplayAble Season
+
+data TermIdentifier = TermIdentifier
+  { year :: Integer -- ^ Using 'Integer' to model years is consistent with 'Data.Time.Calendar'
+  , season :: Season
+  } deriving (Show, Read, Eq, Ord, Generic, Typeable)
+
+instance Binary TermIdentifier
+
+instance Enum TermIdentifier where
+  -- ^ Do not use for conversion – Enumeration only
+  toEnum int = let (toInteger -> year, toEnum -> season) = int `divMod` 2 in TermIdentifier{..}
+  fromEnum TermIdentifier{..} = fromInteger year * 2 + fromEnum season
+
+-- Conversion TermId <-> TermIdentifier::
+-- from_TermId_to_TermIdentifier = unTermKey
+-- from_TermIdentifier_to_TermId = TermKey
+
+shortened :: Iso' Integer Integer
+-- ^ Year numbers shortened to two digits
+shortened = iso shorten expand
+  where
+    century = ($currentYear `div` 100) * 100
+    expand year
+      | 0 <= year
+      , year < 100 = let
+          options = [ expanded | offset <- [-1, 0, 1]
+                               , let century' = century + offset * 100
+                                     expanded = century' + year
+                               , $currentYear - 50 <= expanded
+                               , expanded < $currentYear + 50
+                               ]
+          in case options of
+               [unique] -> unique
+               failed   -> error $ "Could not expand year " ++ show year ++ ": " ++ show failed
+      | otherwise = year
+    shorten year
+      | $currentYear - 50 <= year
+      , year < $currentYear + 50 = year `mod` 100
+      | otherwise = year
+
+termToText :: TermIdentifier -> Text
+termToText TermIdentifier{..} = Text.pack $ seasonToChar season : show (year ^. shortened)
+
+-- also see Hander.Utils.tidFromText
+termFromText :: Text -> Either Text TermIdentifier
+termFromText t
+  | (s:ys) <- Text.unpack t
+  , Just (review shortened -> year) <- readMaybe ys
+  , Right season <- seasonFromChar s
+  = Right TermIdentifier{..}
+  | otherwise = Left $ "Invalid TermIdentifier: “" <> t <> "”" -- TODO: Could be improved, I.e. say "W"/"S" from Number
+
+termToRational :: TermIdentifier -> Rational
+termToRational TermIdentifier{..} = fromInteger year + seasonOffset
+  where
+    seasonOffset
+      | Summer <- season = 0
+      | Winter <- season = 0.5
+
+termFromRational :: Rational -> TermIdentifier
+termFromRational n = TermIdentifier{..}
+  where
+    year = floor n
+    remainder = n - fromInteger (floor n)
+    season
+      | remainder == 0 = Summer
+      | otherwise      = Winter
+
+instance PersistField TermIdentifier where
+  toPersistValue = PersistRational . termToRational
+  fromPersistValue (PersistRational t) = Right $ termFromRational t
+  fromPersistValue x = Left $ "Expected TermIdentifier, received: " <> tshow x
+
+instance PersistFieldSql TermIdentifier where
+  sqlType _ = SqlNumeric 5 1
+
+instance ToHttpApiData TermIdentifier where
+  toUrlPiece = termToText
+
+instance FromHttpApiData TermIdentifier where
+  parseUrlPiece = termFromText
+
+instance PathPiece TermIdentifier where
+  fromPathPiece = either (const Nothing) Just . termFromText
+  toPathPiece = termToText
+
+instance ToJSON TermIdentifier where
+  toJSON = Aeson.String . termToText
+
+instance FromJSON TermIdentifier where
+  parseJSON = withText "Term" $ either (fail . Text.unpack) return . termFromText
+
+{- Must be defined in a later module:
+    termField :: Field (HandlerT UniWorX IO) TermIdentifier
+    termField = checkMMap (return . termFromText) termToText textField
+   See Handler.Utils.Form.termsField and termActiveField
+-}
+
+
+withinTerm :: Day -> TermIdentifier -> Bool
+time `withinTerm` term = timeYear `mod` 100 == termYear `mod` 100
+  where
+    timeYear = fst3 $ toGregorian time
+    termYear = year term
+
+
+data OccurenceSchedule = ScheduleWeekly
+                         { scheduleDayOfWeek :: WeekDay
+                         , scheduleStart     :: TimeOfDay
+                         , scheduleEnd       :: TimeOfDay
+                         }
+  deriving (Eq, Ord, Read, Show, Generic, Typeable)
+
+deriveJSON defaultOptions
+  { fieldLabelModifier = camelToPathPiece' 1
+  , constructorTagModifier = camelToPathPiece' 1
+  , tagSingleConstructors = True
+  , sumEncoding = TaggedObject "repeat" "schedule"
+  } ''OccurenceSchedule
+
+data OccurenceException = ExceptOccur
+                          { exceptDay   :: Day
+                          , exceptStart :: TimeOfDay
+                          , exceptEnd   :: TimeOfDay
+                          }
+                        | ExceptNoOccur
+                          { exceptTime  :: LocalTime
+                          }
+  deriving (Eq, Ord, Read, Show, Generic, Typeable)
+
+deriveJSON defaultOptions
+  { fieldLabelModifier = camelToPathPiece' 1
+  , constructorTagModifier = camelToPathPiece' 1
+  , sumEncoding = TaggedObject "exception" "for"
+  } ''OccurenceException
+
+data Occurences = Occurences
+  { occurencesScheduled  :: Set OccurenceSchedule
+  , occurencesExceptions :: Set OccurenceException
+  } deriving (Eq, Ord, Read, Show, Generic, Typeable)
+
+deriveJSON defaultOptions
+  { fieldLabelModifier = camelToPathPiece' 1
+  } ''Occurences
+derivePersistFieldJSON ''Occurences
+
diff --git a/src/Model/Types/Exam.hs b/src/Model/Types/Exam.hs
new file mode 100644
index 000000000..66abbe195
--- /dev/null
+++ b/src/Model/Types/Exam.hs
@@ -0,0 +1,47 @@
+{-|
+Module: Model.Types.Exam
+Description: Types for modeling Exams
+-}
+module Model.Types.Exam
+  ( module Model.Types.Exam
+  ) where
+
+import Import.NoModel
+import Model.Types.Common
+
+data ExamPartResult = ExamAttended { examPartResult :: Maybe Points }
+                    | ExamNoShow
+                    | ExamVoided
+  deriving (Show, Read, Eq, Ord, Generic, Typeable)
+deriveJSON defaultOptions
+  { constructorTagModifier = camelToPathPiece' 1
+  , fieldLabelModifier = camelToPathPiece' 2
+  , omitNothingFields = True
+  , sumEncoding = TaggedObject "status" "result"
+  } ''ExamPartResult
+derivePersistFieldJSON ''ExamPartResult
+
+data ExamBonusRule = ExamNoBonus
+                   | ExamBonusPoints
+                     { bonusExchangeRate :: Rational
+                     , bonusOnlyPassed :: Bool
+                     }
+  deriving (Show, Read, Eq, Ord, Generic, Typeable)
+deriveJSON defaultOptions
+  { constructorTagModifier = camelToPathPiece' 1
+  , fieldLabelModifier = camelToPathPiece' 1
+  , sumEncoding = TaggedObject "rule" "settings"
+  } ''ExamBonusRule
+derivePersistFieldJSON ''ExamBonusRule
+
+data ExamOccurenceRule = ExamRoomManual
+                       | ExamRoomSurname
+                       | ExamRoomMatriculation
+                       | ExamRoomRandom
+  deriving (Show, Read, Eq, Ord, Generic, Typeable)
+deriveJSON defaultOptions
+  { constructorTagModifier = camelToPathPiece' 2
+  , fieldLabelModifier = camelToPathPiece' 1
+  , sumEncoding = TaggedObject "rule" "settings"
+  } ''ExamOccurenceRule
+derivePersistFieldJSON ''ExamOccurenceRule
diff --git a/src/Model/Types/Health.hs b/src/Model/Types/Health.hs
new file mode 100644
index 000000000..aea99d735
--- /dev/null
+++ b/src/Model/Types/Health.hs
@@ -0,0 +1,87 @@
+{-|
+Module: Model.Types.Health
+Description: Types for running self-tests
+-}
+module Model.Types.Health
+  ( module Model.Types.Health
+  ) where
+
+import Import.NoModel
+
+
+data HealthCheck
+  = HealthCheckMatchingClusterConfig
+  | HealthCheckHTTPReachable
+  | HealthCheckLDAPAdmins
+  | HealthCheckSMTPConnect
+  | HealthCheckWidgetMemcached
+  deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable)
+instance Universe HealthCheck
+instance Finite HealthCheck
+instance Hashable HealthCheck
+
+deriveJSON defaultOptions
+  { constructorTagModifier = camelToPathPiece' 2
+  } ''HealthCheck
+nullaryPathPiece ''HealthCheck $ camelToPathPiece' 2
+pathPieceJSONKey ''HealthCheck
+  
+data HealthReport
+  = HealthMatchingClusterConfig { healthMatchingClusterConfig :: Bool }
+    -- ^ Is the database-stored configuration we're running under still up to date?
+    --
+    -- Also tests database connection as a side effect
+  | HealthHTTPReachable { healthHTTPReachable :: Maybe Bool }
+    -- ^ Can we reach a uni2work-instance with the same `ClusterId` under our configured `approot` via HTTP?
+  | HealthLDAPAdmins { healthLDAPAdmins :: Maybe Rational }
+    -- ^ Proportion of school admins that could be found in LDAP
+  | HealthSMTPConnect { healthSMTPConnect :: Maybe Bool }
+    -- ^ Can we connect to the SMTP server and say @NOOP@?
+  | HealthWidgetMemcached { healthWidgetMemcached :: Maybe Bool }
+    -- ^ Can we store values in memcached and retrieve them via HTTP?
+  deriving (Eq, Ord, Read, Show, Data, Generic, Typeable)
+
+instance NFData HealthReport
+
+deriveJSON defaultOptions
+  { constructorTagModifier = camelToPathPiece' 1
+  , fieldLabelModifier = camelToPathPiece' 1
+  , omitNothingFields  = True
+  , sumEncoding = TaggedObject "test" "result"
+  , tagSingleConstructors = True
+  } ''HealthReport
+
+classifyHealthReport :: HealthReport -> HealthCheck
+classifyHealthReport HealthMatchingClusterConfig{} = HealthCheckMatchingClusterConfig
+classifyHealthReport HealthLDAPAdmins{}            = HealthCheckLDAPAdmins
+classifyHealthReport HealthHTTPReachable{}         = HealthCheckHTTPReachable
+classifyHealthReport HealthSMTPConnect{}           = HealthCheckSMTPConnect
+classifyHealthReport HealthWidgetMemcached{}       = HealthCheckWidgetMemcached
+
+-- | `HealthReport` classified (`classifyHealthReport`) by badness
+--
+-- > a < b = a `worseThan` b
+--
+-- Currently all consumers of this type check for @(== HealthSuccess)@; this
+-- needs to be adjusted on a case-by-case basis if new constructors are added
+data HealthStatus = HealthFailure | HealthSuccess
+  deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable)
+
+instance Universe HealthStatus
+instance Finite HealthStatus
+
+deriveJSON defaultOptions
+  { constructorTagModifier = camelToPathPiece' 1
+  } ''HealthStatus
+nullaryPathPiece ''HealthStatus $ camelToPathPiece' 1
+
+healthReportStatus :: HealthReport -> HealthStatus
+-- ^ Classify `HealthReport` by badness
+healthReportStatus = \case
+  HealthMatchingClusterConfig       False  -> HealthFailure
+  HealthHTTPReachable         (Just False) -> HealthFailure
+  HealthLDAPAdmins            (Just prop )
+    | prop <= 0                            -> HealthFailure
+  HealthSMTPConnect           (Just False) -> HealthFailure 
+  HealthWidgetMemcached       (Just False) -> HealthFailure -- TODO: investigate this failure mode; do we just handle it gracefully?
+  _other                                   -> maxBound -- Minimum badness
diff --git a/src/Model/Types/Mail.hs b/src/Model/Types/Mail.hs
new file mode 100644
index 000000000..d2507e6f9
--- /dev/null
+++ b/src/Model/Types/Mail.hs
@@ -0,0 +1,75 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE UndecidableInstances #-}
+
+{-|
+Module: Model.Types.Mail
+Description: Types related to Notifications
+-}
+
+module Model.Types.Mail
+  ( module Model.Types.Mail
+  ) where
+
+import Import.NoModel
+
+import qualified Data.Aeson.Types as Aeson
+
+import qualified Data.HashMap.Strict as HashMap
+
+
+-- ^ `NotificationSettings` is for now a series of boolean checkboxes, i.e. a mapping @NotificationTrigger -> Bool@
+--
+-- Could maybe be replaced with `Structure Notification` in the long term
+data NotificationTrigger
+  = NTSubmissionRatedGraded
+  | NTSubmissionRated
+  | NTSheetActive
+  | NTSheetSoonInactive
+  | NTSheetInactive
+  | NTCorrectionsAssigned
+  | NTCorrectionsNotDistributed
+  | NTUserRightsUpdate
+  deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable)
+
+instance Universe NotificationTrigger
+instance Finite NotificationTrigger
+
+instance Hashable NotificationTrigger
+
+deriveJSON defaultOptions
+  { constructorTagModifier = intercalate "-" . map toLower . drop 1 . splitCamel
+  } ''NotificationTrigger
+
+instance ToJSONKey NotificationTrigger where
+  toJSONKey = toJSONKeyText $ \v -> let Aeson.String t = toJSON v in t
+
+instance FromJSONKey NotificationTrigger where
+  fromJSONKey = FromJSONKeyTextParser $ parseJSON . Aeson.String
+
+
+newtype NotificationSettings = NotificationSettings { notificationAllowed :: NotificationTrigger -> Bool }
+  deriving (Generic, Typeable)
+  deriving newtype (Eq, Ord, Read, Show)
+
+instance Default NotificationSettings where
+  def = NotificationSettings $ \case
+    NTSubmissionRatedGraded -> True
+    NTSubmissionRated -> False
+    NTSheetActive -> True
+    NTSheetSoonInactive -> False
+    NTSheetInactive -> True
+    NTCorrectionsAssigned -> True
+    NTCorrectionsNotDistributed -> True
+    NTUserRightsUpdate -> True
+
+instance ToJSON NotificationSettings where
+  toJSON v = toJSON . HashMap.fromList $ map (id &&& notificationAllowed v) universeF
+
+instance FromJSON NotificationSettings where
+  parseJSON = Aeson.withObject "NotificationSettings" $ \o -> do
+    o' <- parseJSON $ Aeson.Object o :: Aeson.Parser (HashMap NotificationTrigger Bool)
+    return . NotificationSettings $ \n -> case HashMap.lookup n o' of
+      Nothing -> notificationAllowed def n
+      Just b  -> b
+
+derivePersistFieldJSON ''NotificationSettings
diff --git a/src/Model/Types/Misc.hs b/src/Model/Types/Misc.hs
new file mode 100644
index 000000000..efe0308a6
--- /dev/null
+++ b/src/Model/Types/Misc.hs
@@ -0,0 +1,44 @@
+{-|
+Module: Model.Types.Misc
+Description: Additional uncategorized types
+-}
+
+module Model.Types.Misc
+  ( module Model.Types.Misc
+  ) where
+
+import Import.NoModel
+import Control.Lens
+
+import Data.Maybe (fromJust)
+
+import qualified Data.Text as Text
+import qualified Data.Text.Lens as Text
+
+
+data StudyFieldType = FieldPrimary | FieldSecondary
+  deriving (Eq, Ord, Enum, Show, Read, Bounded, Generic)
+derivePersistField "StudyFieldType"
+
+
+data Theme
+  = ThemeDefault
+  | ThemeLavender
+  | ThemeNeutralBlue
+  | ThemeAberdeenReds
+  | ThemeMossGreen
+  | ThemeSkyLove
+  deriving (Eq, Ord, Bounded, Enum, Show, Read, Generic)
+
+deriveJSON defaultOptions
+  { constructorTagModifier = fromJust . stripPrefix "Theme"
+  } ''Theme
+
+instance Universe Theme
+instance Finite Theme
+
+nullaryPathPiece ''Theme $ camelToPathPiece' 1
+
+$(deriveSimpleWith ''DisplayAble 'display (over Text.packed $ Text.intercalate " " . unsafeTail . splitCamel) ''Theme) -- describe theme to user
+
+derivePersistField "Theme"
diff --git a/src/Model/Types/Security.hs b/src/Model/Types/Security.hs
new file mode 100644
index 000000000..1c1919fdf
--- /dev/null
+++ b/src/Model/Types/Security.hs
@@ -0,0 +1,143 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+
+{-|
+Module: Model.Types.Security
+Description: Types for authentication and authorisation
+-}
+
+module Model.Types.Security
+  ( module Model.Types.Security
+  ) where
+
+import Import.NoModel
+
+import Data.Set (Set)
+
+import qualified Data.Text as Text
+
+import qualified Data.HashMap.Strict as HashMap
+
+import qualified Data.Aeson.Types as Aeson
+
+import qualified Data.Binary as Binary
+
+
+data AuthenticationMode = AuthLDAP
+                        | AuthPWHash { authPWHash :: Text }
+  deriving (Eq, Ord, Read, Show, Generic)
+
+deriveJSON defaultOptions
+  { constructorTagModifier = intercalate "-" . map toLower . drop 1 . splitCamel
+  , fieldLabelModifier = intercalate "-" . map toLower . drop 1 . splitCamel
+  , sumEncoding = UntaggedValue
+  } ''AuthenticationMode
+
+derivePersistFieldJSON ''AuthenticationMode
+
+
+data AuthTag -- sortiert nach gewünschter Reihenfolge auf /authpreds, d.h. Prädikate sind sortier nach Relevanz für Benutzer
+  = AuthAdmin
+  | AuthLecturer
+  | AuthCorrector
+  | AuthTutor
+  | AuthCourseRegistered
+  | AuthTutorialRegistered
+  | AuthParticipant
+  | AuthTime
+  | AuthMaterials
+  | AuthOwner
+  | AuthRated
+  | AuthUserSubmissions
+  | AuthCorrectorSubmissions
+  | AuthCapacity
+  | AuthRegisterGroup
+  | AuthEmpty
+  | AuthSelf
+  | AuthAuthentication
+  | AuthNoEscalation
+  | AuthRead
+  | AuthWrite
+  | AuthToken
+  | AuthDeprecated
+  | AuthDevelopment
+  | AuthFree
+  deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic, Typeable)
+
+instance Universe AuthTag
+instance Finite AuthTag
+instance Hashable AuthTag
+
+deriveJSON defaultOptions
+  { constructorTagModifier = camelToPathPiece' 1
+  } ''AuthTag
+
+nullaryPathPiece ''AuthTag (camelToPathPiece' 1)
+
+instance ToJSONKey AuthTag where
+  toJSONKey = toJSONKeyText $ \v -> let Aeson.String t = toJSON v in t
+
+instance FromJSONKey AuthTag where
+  fromJSONKey = FromJSONKeyTextParser $ parseJSON . Aeson.String
+
+instance Binary AuthTag
+
+
+newtype AuthTagActive = AuthTagActive { authTagIsActive :: AuthTag -> Bool }
+  deriving (Read, Show, Generic)
+  deriving newtype (Eq, Ord)
+
+instance Default AuthTagActive where
+  def = AuthTagActive $ \case
+    AuthAdmin -> False
+    _ -> True
+
+instance ToJSON AuthTagActive where
+  toJSON v = toJSON . HashMap.fromList $ map (id &&& authTagIsActive v) universeF
+
+instance FromJSON AuthTagActive where
+  parseJSON = Aeson.withObject "AuthTagActive" $ \o -> do
+    o' <- parseJSON $ Aeson.Object o :: Aeson.Parser (HashMap AuthTag Bool)
+    return . AuthTagActive $ \n -> case HashMap.lookup n o' of
+      Nothing -> authTagIsActive def n
+      Just b  -> b
+
+derivePersistFieldJSON ''AuthTagActive
+
+
+data PredLiteral a = PLVariable { plVar :: a } | PLNegated { plVar :: a }
+  deriving (Eq, Ord, Read, Show, Generic, Typeable)
+
+instance Hashable a => Hashable (PredLiteral a)
+deriveJSON defaultOptions
+  { constructorTagModifier = camelToPathPiece' 1
+  , sumEncoding = TaggedObject "val" "var"
+  } ''PredLiteral
+
+instance PathPiece a => PathPiece (PredLiteral a) where
+  toPathPiece PLVariable{..} = toPathPiece plVar
+  toPathPiece PLNegated{..} = "¬" <> toPathPiece plVar
+
+  fromPathPiece t = PLVariable <$> fromPathPiece t
+                <|> PLNegated <$> (Text.stripPrefix "¬" t >>= fromPathPiece)
+
+instance Binary a => Binary (PredLiteral a)
+
+
+newtype PredDNF a = PredDNF { dnfTerms :: Set (NonNull (Set (PredLiteral a))) }
+  deriving (Eq, Ord, Read, Show, Generic, Typeable)
+  deriving newtype (Semigroup, Monoid)
+
+$(return [])
+
+instance ToJSON a => ToJSON (PredDNF a) where
+  toJSON = $(mkToJSON predNFAesonOptions ''PredDNF)
+instance (Ord a, FromJSON a) => FromJSON (PredDNF a) where
+  parseJSON = $(mkParseJSON predNFAesonOptions ''PredDNF)
+
+instance (Ord a, Binary a) => Binary (PredDNF a) where
+  get = PredDNF <$> Binary.get
+  put = Binary.put . dnfTerms
+
+type AuthLiteral = PredLiteral AuthTag
+
+type AuthDNF = PredDNF AuthTag
diff --git a/src/Model/Types/Sheet.hs b/src/Model/Types/Sheet.hs
new file mode 100644
index 000000000..74fb91dc1
--- /dev/null
+++ b/src/Model/Types/Sheet.hs
@@ -0,0 +1,307 @@
+{-|
+Module: Model.Types.Sheet
+Description: Types for modeling sheets
+-}
+
+module Model.Types.Sheet
+  ( module Model.Types.Sheet
+  ) where
+
+import Import.NoModel
+import Model.Types.Common
+import Utils.Lens.TH
+
+import Control.Lens
+import Generics.Deriving.Monoid (memptydefault, mappenddefault)
+
+import Data.Set (Set)
+import qualified Data.Set as Set
+import qualified Data.Map as Map
+import Data.Aeson.TH (deriveJSON, defaultOptions, Options(..), SumEncoding(..))
+
+import Text.Blaze (Markup)
+
+import Yesod.Core.Dispatch (PathPiece(..))
+
+import Data.Maybe (fromJust)
+
+
+data SheetGrading
+  = Points     { maxPoints :: Points }
+  | PassPoints { maxPoints, passingPoints :: Points }
+  | PassBinary -- non-zero means passed
+  deriving (Eq, Read, Show, Generic)
+
+deriveJSON defaultOptions
+  { constructorTagModifier = camelToPathPiece
+  , fieldLabelModifier = intercalate "-" . map toLower . dropEnd 1 . splitCamel
+  , sumEncoding = TaggedObject "type" "data"
+  } ''SheetGrading
+derivePersistFieldJSON ''SheetGrading
+
+makeLenses_ ''SheetGrading
+
+_passingBound :: Fold SheetGrading (Either () Points)
+_passingBound = folding passPts
+  where
+    passPts :: SheetGrading -> Maybe (Either () Points)
+    passPts Points{}                  = Nothing
+    passPts PassPoints{passingPoints} = Just $ Right passingPoints
+    passPts PassBinary                = Just $ Left ()
+
+gradingPassed :: SheetGrading -> Points -> Maybe Bool
+gradingPassed gr pts = either pBinary pPoints <$> gr ^? _passingBound
+    where pBinary _ = pts /= 0
+          pPoints b = pts >= b
+
+
+data SheetGradeSummary = SheetGradeSummary
+  { numSheets       :: Count       -- Total number of sheets, includes all
+  , numSheetsPasses :: Count       -- Number of sheets required to pass FKA: numGradePasses
+  , numSheetsPoints :: Count       -- Number of sheets having points    FKA: sumGradePointsd
+  , sumSheetsPoints :: Sum Points  -- Total of all points in all sheets
+  -- Marking dependend
+  , numMarked       :: Count       -- Number of already marked sheets
+  , numMarkedPasses :: Count       -- Number of already marked sheets with passes
+  , numMarkedPoints :: Count       -- Number of already marked sheets with points
+  , sumMarkedPoints :: Sum Points  -- Achieveable points within marked sheets
+  --
+  , achievedPasses :: Count        -- Achieved passes (within marked sheets)
+  , achievedPoints :: Sum Points   -- Achieved points (within marked sheets)
+  } deriving (Generic, Read, Show, Eq)
+
+instance Monoid SheetGradeSummary where
+  mempty  = memptydefault
+  mappend = mappenddefault
+
+instance Semigroup SheetGradeSummary where
+  (<>) = mappend -- TODO: remove for GHC > 8.4.x
+
+makeLenses_ ''SheetGradeSummary
+
+sheetGradeSum :: SheetGrading -> Maybe Points -> SheetGradeSummary
+sheetGradeSum gr Nothing  = mempty
+  { numSheets = 1
+  , numSheetsPasses = bool  mempty   1 $ has _passingBound gr
+  , numSheetsPoints = bool  mempty   1 $ has _maxPoints    gr
+  , sumSheetsPoints = maybe mempty Sum $ gr ^? _maxPoints
+  }
+sheetGradeSum gr (Just p) =
+  let unmarked@SheetGradeSummary{..} = sheetGradeSum gr Nothing
+  in  unmarked
+        { numMarked       = numSheets
+        , numMarkedPasses = numSheetsPasses
+        , numMarkedPoints = numSheetsPoints
+        , sumMarkedPoints = sumSheetsPoints
+        , achievedPasses  = maybe mempty (bool 0 1) (gradingPassed gr p)
+        , achievedPoints  = bool mempty (Sum p) $ has _maxPoints gr
+        }
+
+
+data SheetType
+  = NotGraded
+  | Normal        { grading :: SheetGrading }
+  | Bonus         { grading :: SheetGrading }
+  | Informational { grading :: SheetGrading }
+  deriving (Eq, Read, Show, Generic)
+
+deriveJSON defaultOptions
+  { constructorTagModifier = camelToPathPiece
+  , fieldLabelModifier = camelToPathPiece
+  , sumEncoding = TaggedObject "type" "data"
+  } ''SheetType
+derivePersistFieldJSON ''SheetType
+
+data SheetTypeSummary = SheetTypeSummary
+  { normalSummary
+  , bonusSummary
+  , informationalSummary :: SheetGradeSummary
+  , numNotGraded :: Count
+  } deriving (Generic, Read, Show, Eq)
+
+instance Monoid SheetTypeSummary where
+  mempty  = memptydefault
+  mappend = mappenddefault
+
+instance Semigroup SheetTypeSummary where
+  (<>) = mappend -- TODO: remove for GHC > 8.4.x
+
+makeLenses_ ''SheetTypeSummary
+
+sheetTypeSum :: SheetType -> Maybe Points -> SheetTypeSummary
+sheetTypeSum Bonus{..}         mps = mempty { bonusSummary         = sheetGradeSum grading mps }
+sheetTypeSum Normal{..}        mps = mempty { normalSummary        = sheetGradeSum grading mps }
+sheetTypeSum Informational{..} mps = mempty { informationalSummary = sheetGradeSum grading mps }
+sheetTypeSum NotGraded _           = mempty { numNotGraded         = Sum 1 }
+
+data SheetGroup
+  = Arbitrary { maxParticipants :: Natural }
+  | RegisteredGroups
+  | NoGroups
+  deriving (Show, Read, Eq, Generic)
+deriveJSON defaultOptions ''SheetGroup
+derivePersistFieldJSON ''SheetGroup
+
+makeLenses_ ''SheetGroup
+
+data SheetFileType = SheetExercise | SheetHint | SheetSolution | SheetMarking
+  deriving (Show, Read, Eq, Ord, Enum, Bounded, Generic)
+derivePersistField "SheetFileType"
+
+instance Universe SheetFileType
+instance Finite SheetFileType
+
+instance PathPiece SheetFileType where
+  toPathPiece SheetExercise = "file"
+  toPathPiece SheetHint     = "hint"
+  toPathPiece SheetSolution = "solution"
+  toPathPiece SheetMarking  = "marking"
+  fromPathPiece = finiteFromPathPiece
+
+sheetFile2markup :: SheetFileType -> Markup
+sheetFile2markup SheetExercise = iconQuestion
+sheetFile2markup SheetHint     = iconHint
+sheetFile2markup SheetSolution = iconSolution
+sheetFile2markup SheetMarking  = iconMarking
+
+-- $(deriveSimpleWith ''DisplayAble 'display (drop 17) ''SheetFileType)
+-- instance DisplayAble SheetFileType where -- deprecated, see RenderMessage instance in Foundation
+--   display SheetExercise = "Aufgabenstellung"
+--   display SheetHint     = "Hinweise"
+--   display SheetSolution = "Musterlösung"
+--   display SheetMarking  = "Korrekturhinweise"
+
+-- partitionFileType' :: Ord a => [(SheetFileType,a)] -> Map SheetFileType (Set a)
+-- partitionFileType' = groupMap
+
+partitionFileType :: Ord a => [(SheetFileType,a)] -> SheetFileType -> Set a
+partitionFileType fs t = Map.findWithDefault Set.empty t . Map.fromListWith Set.union $ map (over _2 Set.singleton) fs
+
+
+data UploadSpecificFile = UploadSpecificFile
+  { specificFileLabel :: Text
+  , specificFileName :: FileName
+  , specificFileRequired :: Bool
+  } deriving (Show, Read, Eq, Ord, Generic)
+
+deriveJSON defaultOptions
+  { fieldLabelModifier = camelToPathPiece' 2
+  } ''UploadSpecificFile
+derivePersistFieldJSON ''UploadSpecificFile
+
+data UploadMode = NoUpload
+                | UploadAny
+                  { unpackZips :: Bool
+                  , extensionRestriction :: Maybe (NonNull (Set Extension))
+                  }
+                | UploadSpecific
+                  { specificFiles :: NonNull (Set UploadSpecificFile)
+                  }
+  deriving (Show, Read, Eq, Ord, Generic)
+
+defaultExtensionRestriction :: Maybe (NonNull (Set Extension))
+defaultExtensionRestriction = fromNullable $ Set.fromList ["txt", "pdf"]
+
+deriveJSON defaultOptions
+  { constructorTagModifier = \c -> if
+      | c == "UploadAny" -> "upload"
+      | otherwise        -> camelToPathPiece c
+  , fieldLabelModifier = camelToPathPiece
+  , sumEncoding = TaggedObject "mode" "settings"
+  , omitNothingFields = True
+  }''UploadMode
+derivePersistFieldJSON ''UploadMode
+
+data UploadModeDescr = UploadModeNone
+                     | UploadModeAny
+                     | UploadModeSpecific
+  deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable)
+instance Universe UploadModeDescr
+instance Finite UploadModeDescr
+
+nullaryPathPiece ''UploadModeDescr $ camelToPathPiece' 2
+
+classifyUploadMode :: UploadMode -> UploadModeDescr
+classifyUploadMode NoUpload = UploadModeNone
+classifyUploadMode UploadAny{} = UploadModeAny
+classifyUploadMode UploadSpecific{} = UploadModeSpecific
+
+data SubmissionMode = SubmissionMode
+  { submissionModeCorrector :: Bool
+  , submissionModeUser :: Maybe UploadMode
+  }
+  deriving (Show, Read, Eq, Ord, Generic)
+
+deriveJSON defaultOptions
+  { fieldLabelModifier = camelToPathPiece' 2
+  } ''SubmissionMode
+derivePersistFieldJSON ''SubmissionMode
+
+data SubmissionModeDescr = SubmissionModeNone
+                         | SubmissionModeCorrector
+                         | SubmissionModeUser
+                         | SubmissionModeBoth
+  deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable)
+instance Universe SubmissionModeDescr
+instance Finite SubmissionModeDescr
+
+finitePathPiece ''SubmissionModeDescr
+  [ "no-submissions"
+  , "correctors"
+  , "users"
+  , "correctors+users"
+  ]
+
+classifySubmissionMode :: SubmissionMode -> SubmissionModeDescr
+classifySubmissionMode (SubmissionMode False Nothing ) = SubmissionModeNone
+classifySubmissionMode (SubmissionMode True  Nothing ) = SubmissionModeCorrector
+classifySubmissionMode (SubmissionMode False (Just _)) = SubmissionModeUser
+classifySubmissionMode (SubmissionMode True  (Just _)) = SubmissionModeBoth
+
+
+-- | Specify a corrector's workload
+data Load -- = ByTutorial { countsToLoad :: Bool } | ByProportion { load :: Rational }
+    = Load { byTutorial :: Maybe Bool  -- ^ @Just@ all from Tutorial, @True@ if counting towards overall workload
+           , byProportion :: Rational  -- ^ workload proportion of all submission not assigned to tutorial leaders
+           }
+  deriving (Show, Read, Eq, Ord, Generic)
+
+deriveJSON defaultOptions ''Load
+derivePersistFieldJSON ''Load
+
+instance Hashable Load
+
+instance Semigroup Load where
+  (Load byTut prop) <> (Load byTut' prop') = Load byTut'' (prop + prop')
+    where
+      byTut''
+        | Nothing <- byTut  = byTut'
+        | Nothing <- byTut' = byTut
+        | Just a <- byTut
+        , Just b <- byTut'  = Just $ a || b
+
+instance Monoid Load where
+  mempty = Load Nothing 0
+  mappend = (<>)
+
+{- Use (is _ByTutorial) instead of this unneeded definition:
+  isByTutorial :: Load -> Bool
+  isByTutorial (ByTutorial {}) = True
+  isByTutorial _               = False
+-}
+
+data CorrectorState = CorrectorNormal | CorrectorMissing | CorrectorExcused
+  deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic)
+
+deriveJSON defaultOptions
+  { constructorTagModifier = fromJust . stripPrefix "Corrector"
+  } ''CorrectorState
+
+instance Universe CorrectorState
+instance Finite CorrectorState
+
+instance Hashable CorrectorState
+
+nullaryPathPiece ''CorrectorState (camelToPathPiece' 1)
+
+derivePersistField "CorrectorState"
diff --git a/src/Model/Types/Submission.hs b/src/Model/Types/Submission.hs
new file mode 100644
index 000000000..c31fa38fc
--- /dev/null
+++ b/src/Model/Types/Submission.hs
@@ -0,0 +1,151 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+
+{-|
+Module: Model.Types.Submission
+Description: Types to support sheet submissions
+-}
+
+module Model.Types.Submission
+  ( module Model.Types.Submission
+  ) where
+
+import Import.NoModel
+
+import Data.Aeson.Types (ToJSON(..), FromJSON(..))
+import qualified Data.Aeson.Types as Aeson
+
+import Database.Persist.Sql
+
+import Data.Word.Word24
+
+import qualified Data.CaseInsensitive as CI
+
+import Control.Lens
+
+import qualified Data.Text as Text
+import qualified Data.Set as Set
+
+
+import Data.List (elemIndex, genericIndex)
+import Data.Bits
+import Data.Text.Metrics (damerauLevenshtein)
+  
+-------------------------
+-- Submission Download --
+-------------------------
+
+data SubmissionFileType = SubmissionOriginal | SubmissionCorrected
+  deriving (Show, Read, Eq, Ord, Enum, Bounded, Generic)
+
+instance Universe SubmissionFileType
+instance Finite SubmissionFileType
+
+nullaryPathPiece ''SubmissionFileType $ camelToPathPiece' 1
+
+submissionFileTypeIsUpdate :: SubmissionFileType -> Bool
+submissionFileTypeIsUpdate SubmissionOriginal  = False
+submissionFileTypeIsUpdate SubmissionCorrected = True
+
+isUpdateSubmissionFileType :: Bool -> SubmissionFileType
+isUpdateSubmissionFileType False = SubmissionOriginal
+isUpdateSubmissionFileType True  = SubmissionCorrected
+
+---------------------------
+-- Submission Pseudonyms --
+---------------------------
+  
+type PseudonymWord = CI Text
+
+newtype Pseudonym = Pseudonym Word24
+  deriving (Eq, Ord, Read, Show, Generic, Data)
+  deriving newtype (Bounded, Enum, Integral, Num, Real, Ix)
+
+
+instance PersistField Pseudonym where
+  toPersistValue p = toPersistValue (fromIntegral p :: Word32)
+  fromPersistValue v = do
+    w <- fromPersistValue v :: Either Text Word32
+    if
+      | 0 <= w
+      , w <= fromIntegral (maxBound :: Pseudonym)
+        -> return $ fromIntegral w
+      | otherwise
+        -> Left "Pseudonym out of range"
+
+instance PersistFieldSql Pseudonym where
+  sqlType _ = SqlInt32
+
+instance Random Pseudonym where
+  randomR (max minBound -> lo, min maxBound -> hi) gen = over _1 (fromIntegral :: Word32 -> Pseudonym) $ randomR (fromIntegral lo, fromIntegral hi) gen
+  random = randomR (minBound, maxBound)
+
+instance FromJSON Pseudonym where
+  parseJSON v@(Aeson.Number _) = do
+    w <- parseJSON v :: Aeson.Parser Word32
+    if
+      | 0 <= w
+      , w <= fromIntegral (maxBound :: Pseudonym)
+        -> return $ fromIntegral w
+      | otherwise
+        -> fail "Pseudonym out auf range"
+  parseJSON (Aeson.String t)
+    = case t ^? _PseudonymText of
+        Just p -> return p
+        Nothing -> fail "Could not parse pseudonym"
+  parseJSON v = flip (Aeson.withArray "Pseudonym") v $ \ws -> do
+    ws' <- toList . map CI.mk <$> mapM parseJSON ws
+    case ws' ^? _PseudonymWords of
+      Just p -> return p
+      Nothing -> fail "Could not parse pseudonym words"
+
+instance ToJSON Pseudonym where
+  toJSON = toJSON . (review _PseudonymWords :: Pseudonym -> [PseudonymWord])
+
+pseudonymWordlist :: [PseudonymWord]
+pseudonymCharacters :: Set (CI Char)
+(pseudonymWordlist, pseudonymCharacters) = $(wordlist "config/wordlist.txt")
+
+_PseudonymWords :: Prism' [PseudonymWord] Pseudonym
+_PseudonymWords = prism' pToWords pFromWords
+  where
+    pFromWords :: [PseudonymWord] -> Maybe Pseudonym
+    pFromWords [w1, w2]
+      | Just i1 <- elemIndex w1 pseudonymWordlist
+      , Just i2 <- elemIndex w2 pseudonymWordlist
+      , i1 <= maxWord, i2 <= maxWord
+      = Just . Pseudonym $ shiftL (fromIntegral i1) 12 .|. fromIntegral i2
+    pFromWords _ = Nothing
+
+    pToWords :: Pseudonym -> [PseudonymWord]
+    pToWords (Pseudonym p)
+      = [ genericIndex pseudonymWordlist $ shiftR p 12 .&. maxWord
+        , genericIndex pseudonymWordlist $ p .&. maxWord
+        ]
+
+    maxWord :: Num a => a
+    maxWord = 0b111111111111
+
+_PseudonymText :: Prism' Text Pseudonym
+_PseudonymText = prism' tToWords tFromWords . _PseudonymWords
+  where
+    tFromWords :: Text -> Maybe [PseudonymWord]
+    tFromWords input
+      | [result] <- input ^.. pseudonymFragments
+      = Just result
+      | otherwise
+      = Nothing
+
+    tToWords :: [PseudonymWord] -> Text
+    tToWords = Text.unwords . map CI.original
+
+pseudonymWords :: Fold Text PseudonymWord
+pseudonymWords = folding
+  $ \(CI.mk -> input) -> map (view _2) . fromMaybe [] . listToMaybe . groupBy ((==) `on` view _1) . sortBy (comparing $ view _1) . filter ((<= distanceCutoff) . view _1) $ map (distance input &&& id) pseudonymWordlist
+  where
+    distance = damerauLevenshtein `on` CI.foldedCase
+    -- | Arbitrary cutoff point, for reference: ispell cuts off at 1
+    distanceCutoff = 2
+
+pseudonymFragments :: Fold Text [PseudonymWord]
+pseudonymFragments = folding
+  $ mapM (toListOf pseudonymWords) . (\l -> guard (length l == 2) *> l) . filter (not . null) . Text.split (\(CI.mk -> c) -> not $ Set.member c pseudonymCharacters)
diff --git a/src/Model/Types/JSON.hs b/src/Model/Types/TH/JSON.hs
similarity index 98%
rename from src/Model/Types/JSON.hs
rename to src/Model/Types/TH/JSON.hs
index 66ed78163..34a752350 100644
--- a/src/Model/Types/JSON.hs
+++ b/src/Model/Types/TH/JSON.hs
@@ -1,4 +1,4 @@
-module Model.Types.JSON
+module Model.Types.TH.JSON
   ( derivePersistFieldJSON
   , predNFAesonOptions
   ) where
diff --git a/src/Model/Types/Wordlist.hs b/src/Model/Types/TH/Wordlist.hs
similarity index 95%
rename from src/Model/Types/Wordlist.hs
rename to src/Model/Types/TH/Wordlist.hs
index 5cfecd662..de3d159d8 100644
--- a/src/Model/Types/Wordlist.hs
+++ b/src/Model/Types/TH/Wordlist.hs
@@ -1,4 +1,6 @@
-module Model.Types.Wordlist (wordlist) where
+module Model.Types.TH.Wordlist
+  ( wordlist
+  ) where
 
 import ClassyPrelude hiding (lift)
 
diff --git a/src/Network/Mime/TH.hs b/src/Network/Mime/TH.hs
index 0fd1c2beb..486eda779 100644
--- a/src/Network/Mime/TH.hs
+++ b/src/Network/Mime/TH.hs
@@ -1,11 +1,12 @@
 module Network.Mime.TH
-  ( mimeMapFile
+  ( mimeMapFile, mimeSetFile
   ) where
 
 import ClassyPrelude.Yesod hiding (lift)
 import Language.Haskell.TH hiding (Extension)
 import Language.Haskell.TH.Syntax (qAddDependentFile, Lift(..))
 
+import qualified Data.Set as Set
 import qualified Data.Map as Map
 
 import Data.Text (Text)
@@ -18,7 +19,7 @@ import Network.Mime
 import Instances.TH.Lift ()
 
 
-mimeMapFile :: FilePath -> ExpQ
+mimeMapFile, mimeSetFile :: FilePath -> ExpQ
 mimeMapFile file = do
   qAddDependentFile file
   
@@ -36,6 +37,15 @@ mimeMapFile file = do
 
 
   lift mimeMap
+mimeSetFile file = do
+  qAddDependentFile file
+  
+  ls <- runIO $ filter (not . isComment) . Text.lines <$> Text.readFile file
+
+  let mimeSet :: Set MimeType
+      mimeSet = Set.fromList $ map (encodeUtf8 . Text.strip) ls
+
+  lift mimeSet
 
 isComment :: Text -> Bool
 isComment line = or
diff --git a/src/Settings.hs b/src/Settings.hs
index 739ac5554..c53e90269 100644
--- a/src/Settings.hs
+++ b/src/Settings.hs
@@ -10,14 +10,13 @@ module Settings
   , module Settings.Cluster
   ) where
 
-import           ClassyPrelude.Yesod
+import           Import.NoModel
 import Data.UUID (UUID)
 import qualified Control.Exception           as Exception
-import           Data.Aeson                  (Result (..), fromJSON, withObject
+import           Data.Aeson                  (fromJSON, withObject
                                              ,(.!=), (.:?), withScientific
                                              )
 import qualified Data.Aeson.Types as Aeson
-import           Data.Aeson.TH
 import           Data.FileEmbed              (embedFile)
 import           Data.Yaml                   (decodeEither')
 import           Database.Persist.Postgresql (PostgresConf)
@@ -45,7 +44,6 @@ import qualified Data.Text.Encoding as Text
 
 import qualified Ldap.Client as Ldap
 
-import Utils hiding (MessageStatus(..))
 import Control.Lens
 
 import qualified Network.HaskellNet.Auth as HaskellNet (UserName, Password, AuthType(..))
@@ -70,9 +68,11 @@ import Jose.Jwt (JwtEncoding(..))
 
 import System.FilePath.Glob
 import Handler.Utils.Submission.TH
-import Network.Mime
 import Network.Mime.TH
 
+import qualified Data.Map as Map
+import qualified Data.Set as Set
+
 
 -- | Runtime settings to configure this application. These settings can be
 -- loaded from various sources: defaults, environment variables, config files,
@@ -115,9 +115,9 @@ data AppSettings = AppSettings
     , appJwtExpiration          :: Maybe NominalDiffTime
     , appJwtEncoding            :: JwtEncoding
     
-    , appHealthCheckInterval    :: NominalDiffTime
-    , appHealthCheckHTTP        :: Bool
+    , appHealthCheckInterval    :: HealthCheck -> Maybe NominalDiffTime
     , appHealthCheckDelayNotify :: Bool
+    , appHealthCheckHTTP        :: Bool
 
     , appInitialLogSettings     :: LogSettings
 
@@ -386,9 +386,9 @@ instance FromJSON AppSettings where
         appJwtExpiration          <- o .:? "jwt-expiration"
         appJwtEncoding            <- o .: "jwt-encoding"
 
-        appHealthCheckInterval    <- o .:  "health-check-interval"
-        appHealthCheckHTTP        <- o .:  "health-check-http"
+        appHealthCheckInterval    <- (assertM' (> 0) . ) <$> o .: "health-check-interval"
         appHealthCheckDelayNotify <- o .:  "health-check-delay-notify"
+        appHealthCheckHTTP        <- o .:  "health-check-http"
 
         appSessionTimeout         <- o .: "session-timeout"
 
@@ -431,8 +431,17 @@ widgetFileSettings = def
 submissionBlacklist :: [Pattern]
 submissionBlacklist = $(patternFile compDefault "config/submission-blacklist")
 
+mimeMap :: MimeMap
+mimeMap = $(mimeMapFile "config/mimetypes")
+
 mimeLookup :: FileName -> MimeType
-mimeLookup = mimeByExt $(mimeMapFile "config/mimetypes") defaultMimeType
+mimeLookup = mimeByExt mimeMap defaultMimeType
+
+mimeExtensions :: MimeType -> Set Extension
+mimeExtensions needle = Set.fromList [ ext | (ext, typ) <- Map.toList mimeMap, typ == needle ]
+
+archiveTypes :: Set MimeType
+archiveTypes = $(mimeSetFile "config/archive-types")
 
 -- The rest of this file contains settings which rarely need changing by a
 -- user.
@@ -471,5 +480,5 @@ configSettingsYmlValue = either Exception.throw id
 compileTimeAppSettings :: AppSettings
 compileTimeAppSettings =
     case fromJSON $ applyEnvValue False mempty configSettingsYmlValue of
-        Error e -> error e
-        Success settings -> settings
+        Aeson.Error e -> error e
+        Aeson.Success settings -> settings
diff --git a/src/System/FilePath/Instances.hs b/src/System/FilePath/Instances.hs
new file mode 100644
index 000000000..b37e2291a
--- /dev/null
+++ b/src/System/FilePath/Instances.hs
@@ -0,0 +1,16 @@
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+module System.FilePath.Instances
+  (
+  ) where
+
+import ClassyPrelude
+
+import qualified Data.Text as Text
+
+import Web.PathPieces
+
+
+instance {-# OVERLAPS #-} PathMultiPiece FilePath where
+  fromPathMultiPiece = Just . unpack . intercalate "/"
+  toPathMultiPiece = Text.splitOn "/" . pack
diff --git a/src/Time/Types/Instances.hs b/src/Time/Types/Instances.hs
index af91312e3..fa61bca45 100644
--- a/src/Time/Types/Instances.hs
+++ b/src/Time/Types/Instances.hs
@@ -12,8 +12,14 @@ import Data.Universe
 
 import Utils.PathPiece
 
+import Data.Aeson.TH
+
 
 instance Universe WeekDay
 instance Finite WeekDay
 
 nullaryPathPiece ''WeekDay camelToPathPiece
+
+deriveJSON defaultOptions
+  { constructorTagModifier = camelToPathPiece
+  } ''WeekDay
diff --git a/src/Utils.hs b/src/Utils.hs
index c45171ed5..2080947ec 100644
--- a/src/Utils.hs
+++ b/src/Utils.hs
@@ -1,5 +1,3 @@
-{-# OPTIONS_GHC -fno-warn-orphans #-} -- Monad FormResult
-
 module Utils
   ( module Utils
   ) where
@@ -30,7 +28,7 @@ import Utils.Parameters as Utils
 
 import Text.Blaze (Markup, ToMarkup)
 
-import Data.Char (isDigit, isSpace)
+import Data.Char (isDigit, isSpace, isAscii)
 import Data.Text (dropWhileEnd, takeWhileEnd, justifyRight)
 import Numeric (showFFloat)
 
@@ -68,7 +66,7 @@ import qualified Crypto.Saltine.Core.SecretBox as SecretBox
 import qualified Crypto.Saltine.Class as Saltine
 import qualified Crypto.Data.PKCS7 as PKCS7
 
-import Data.Fixed (Centi)
+import Data.Fixed
 import Data.Ratio ((%))
 
 import qualified Data.Binary as Binary
@@ -79,6 +77,8 @@ import Data.Time.Clock
 
 import Data.List.NonEmpty (NonEmpty, nonEmpty)
 
+import Algebra.Lattice (top, bottom, (/\), (\/), BoundedJoinSemiLattice, BoundedMeetSemiLattice)
+
 {-# ANN choice ("HLint: ignore Use asum" :: String) #-}
 
 
@@ -123,33 +123,39 @@ type WidgetSiteless = forall site. forall m. (MonadIO m, MonadThrow m, MonadBase
 -- Icons --
 -----------
 
+-- Create an icon from font-awesome without additional space
+fontAwesomeIcon :: Text -> Markup
+fontAwesomeIcon iconName =
+  [shamlet|$newline never
+            |]
+
 -- We collect all used icons here for an overview.
 -- For consistency, some conditional icons are also provided, e.g. `isIvisble`
 
 iconQuestion :: Markup
-iconQuestion = [shamlet||]
+iconQuestion = fontAwesomeIcon "question-circle"
 
 iconHint :: Markup
-iconHint = [shamlet||]
+iconHint = fontAwesomeIcon "life-ring"
 
 iconSolution :: Markup
-iconSolution = [shamlet||]
+iconSolution =fontAwesomeIcon "exclamation-circle"
 
 iconMarking :: Markup
-iconMarking = [shamlet||]
+iconMarking = fontAwesomeIcon "check-circle"
 
 fileDownload :: Markup
-fileDownload = [shamlet||]
+fileDownload = fontAwesomeIcon "file-download"
 
 zipDownload :: Markup
-zipDownload = [shamlet||]
+zipDownload = fontAwesomeIcon "file-archive"
 
 -- Conditional icons
 
 isVisible :: Bool -> Markup
 -- ^ Display an icon that denotes that something™ is visible or invisible
-isVisible True  = [shamlet||]
-isVisible False = [shamlet||]
+isVisible True  = fontAwesomeIcon "eye"
+isVisible False = fontAwesomeIcon "eye-slash"
 --
 -- For documentation on how to avoid these unneccessary functions
 -- we implement them here just once for the first icon:
@@ -165,26 +171,26 @@ maybeIsVisibleWidget = toWidget . foldMap isVisible
 -- Other _frequently_ used icons:
 hasComment :: Bool -> Markup
 -- ^ Display an icon that denotes that something™ has a comment or not
-hasComment True  = [shamlet||]
-hasComment False = [shamlet||] -- comment-alt-slash is not available for free
+hasComment True  = fontAwesomeIcon "comment-alt"
+hasComment False = fontAwesomeIcon "comment-slash" -- comment-alt-slash is not available for free
 
 hasTickmark :: Bool -> Markup
 -- ^ Display an icon that denotes that something™ is okay
-hasTickmark True  = [shamlet||]
+hasTickmark True  = fontAwesomeIcon "check"
 hasTickmark False = mempty
 
 isBad :: Bool -> Markup
 -- ^ Display an icon that denotes that something™ is bad
-isBad True  = [shamlet||] -- or times?!
+isBad True  = fontAwesomeIcon "bolt" -- or times?!
 isBad False = mempty
 
 isNew :: Bool -> Markup
-isNew True  = [shamlet||] -- was exclamation
+isNew True  = fontAwesomeIcon "seedling" -- was exclamation
 isNew False = mempty
 
 boolSymbol :: Bool -> Markup
-boolSymbol True  = [shamlet||]
-boolSymbol False = [shamlet||]
+boolSymbol True  = fontAwesomeIcon "check"
+boolSymbol False = fontAwesomeIcon "times"
 
 
 
@@ -243,8 +249,8 @@ class DisplayAble a where
 instance DisplayAble Text where
   display = id
 
-instance DisplayAble String where
-  display = pack
+-- instance DisplayAble String where
+--   display = pack
 
 instance DisplayAble Int
 instance DisplayAble Int64
@@ -269,6 +275,12 @@ instance DisplayAble a => DisplayAble (E.Value a) where
 instance DisplayAble a => DisplayAble (CI a) where
   display = display . CI.original
 
+instance HasResolution a => DisplayAble (Fixed a) where
+  display = pack . showFixed True
+
+instance DisplayAble a => DisplayAble (Sum a) where
+  display = display . getSum
+
 {- We do not want DisplayAble for every Show-Class:
    We want to explicitly verify that the resulting text can be displayed to the User!
    For example: UTCTime values were shown without proper format rendering!
@@ -712,6 +724,16 @@ mconcatForM = flip mconcatMapM
 findM :: (Monad m, Foldable f) => (a -> MaybeT m b) -> f a -> m (Maybe b)
 findM f = runMaybeT . Fold.foldr (\x as -> f x <|> as) mzero
 
+-------------
+-- Conduit --
+-------------
+
+peekN :: (Integral n, Monad m) => n -> Consumer a m [a]
+peekN n = do
+  peeked <- catMaybes <$> replicateM (fromIntegral n) await
+  mapM_ leftover peeked
+  return peeked
+
 -----------------
 -- Alternative --
 -----------------
@@ -775,6 +797,33 @@ addCustomHeader, replaceOrAddCustomHeader :: (MonadHandler m, PathPiece payload)
 addCustomHeader ident payload = addHeader (toPathPiece ident) (toPathPiece payload)
 replaceOrAddCustomHeader ident payload = replaceOrAddHeader (toPathPiece ident) (toPathPiece payload)
 
+------------------
+-- HTTP Headers --
+------------------
+
+data ContentDisposition = ContentInline | ContentAttachment
+  deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable)
+instance Universe ContentDisposition
+instance Finite ContentDisposition
+nullaryPathPiece ''ContentDisposition $ camelToPathPiece' 1
+
+setContentDisposition :: MonadHandler m => ContentDisposition -> Maybe FilePath -> m ()
+-- ^ Set a @Content-Disposition@-header using `replaceOrAddHeader`
+--
+-- Takes care of correct formatting and encoding of non-ascii filenames
+setContentDisposition cd (fmap pack -> mFName) = replaceOrAddHeader "Content-Disposition" headerVal
+  where
+    headerVal
+      | Just fName <- mFName
+      , Text.all isAscii fName
+      , Text.all (not . flip elem ['"', '\\']) fName
+      = [st|#{toPathPiece cd}; filename="#{fName}"|]
+      | Just fName <- mFName
+      = let encoded = decodeUtf8 . urlEncode True $ encodeUtf8 fName
+         in [st|#{toPathPiece cd}; filename*=UTF-8''#{encoded}|]
+      | otherwise
+      = toPathPiece cd
+
 ------------------
 -- Cryptography --
 ------------------
@@ -893,3 +942,13 @@ setLastModified lastModified = do
     precision = 1
 
     safeMethods = [ methodGet, methodHead, methodOptions ]
+
+--------------
+-- Lattices --
+--------------
+
+foldJoin :: (MonoFoldable mono, BoundedJoinSemiLattice (Element mono)) => mono -> Element mono
+foldJoin = foldr (\/) bottom
+
+foldMeet :: (MonoFoldable mono, BoundedMeetSemiLattice (Element mono)) => mono -> Element mono
+foldMeet = foldr (/\) top
diff --git a/src/Utils/DateTime.hs b/src/Utils/DateTime.hs
index 0b5855566..3f66c65ee 100644
--- a/src/Utils/DateTime.hs
+++ b/src/Utils/DateTime.hs
@@ -1,5 +1,4 @@
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# OPTIONS_GHC -fno-warn-orphans #-}
 
 module Utils.DateTime
   ( timeLocaleMap
@@ -14,10 +13,9 @@ module Utils.DateTime
 import ClassyPrelude.Yesod hiding (lift)
 import System.Locale.Read
 
-import Data.Time (TimeZone(..), TimeLocale(..))
+import Data.Time (TimeLocale(..))
 import Data.Time.Zones (TZ)
 import Data.Time.Zones.TH (includeSystemTZ)
-import Data.Time.Clock.POSIX
 
 import Language.Haskell.TH
 import Language.Haskell.TH.Syntax (Lift(..))
@@ -35,11 +33,8 @@ import Data.Aeson.TH
 
 import Utils.PathPiece
 
-deriving instance Lift TimeZone
-deriving instance Lift TimeLocale
-
-instance Hashable UTCTime where
-  hashWithSalt s = hashWithSalt s . toRational . utcTimeToPOSIXSeconds
+import Data.Time.Format.Instances ()
+  
 
 -- $(timeLocaleMap _) :: [Lang] -> TimeLocale
 timeLocaleMap :: [(Lang, String)] -- ^ Languages and matching locales, first is taken as default
@@ -91,7 +86,7 @@ instance Finite SelDateTimeFormat
 instance Hashable SelDateTimeFormat
 
 deriveJSON defaultOptions
-  { constructorTagModifier = intercalate "-" . map toLower . drop 2 . splitCamel
+  { constructorTagModifier = camelToPathPiece' 2
   } ''SelDateTimeFormat
 
 instance ToJSONKey SelDateTimeFormat where
diff --git a/src/Utils/Form.hs b/src/Utils/Form.hs
index ad62f224f..2c04192ec 100644
--- a/src/Utils/Form.hs
+++ b/src/Utils/Form.hs
@@ -24,6 +24,7 @@ import Control.Monad.Trans.Maybe (MaybeT(..))
 import Control.Monad.Reader.Class (MonadReader(..))
 import Control.Monad.Writer.Class (MonadWriter(..))
 import Control.Monad.Trans.RWS (mapRWST)
+import Control.Monad.Trans.Except (ExceptT, runExceptT)
 
 import Data.List ((!!))
 
@@ -445,6 +446,29 @@ optionsFinite = do
 rationalField :: (MonadHandler m, RenderMessage (HandlerSite m) FormMessage) => Field m Rational
 rationalField = convertField toRational fromRational doubleField
 
+data SecretJSONFieldException = SecretJSONFieldDecryptFailure
+  deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable)
+instance Exception SecretJSONFieldException
+
+secretJsonField :: ( ToJSON a, FromJSON a
+                   , MonadHandler m
+                   , MonadSecretBox (ExceptT EncodedSecretBoxException m)
+                   , MonadSecretBox (WidgetT (HandlerSite m) IO)
+                   , RenderMessage (HandlerSite m) FormMessage
+                   , RenderMessage (HandlerSite m) SecretJSONFieldException
+                   )
+                => Field m a
+secretJsonField = Field{..}
+  where
+    fieldParse [v] [] = bimap (\_ -> SomeMessage SecretJSONFieldDecryptFailure) Just <$> runExceptT (encodedSecretBoxOpen v)
+    fieldParse [] [] = return $ Right Nothing
+    fieldParse _ _ = return . Left $ SomeMessage MsgValueRequired
+    fieldView theId name attrs val _isReq = do
+      val' <- traverse (encodedSecretBox SecretBoxShort) val
+      [whamlet|
+        
+      |]
+    fieldEnctype = UrlEncoded
 
 -----------
 -- Forms --
@@ -522,6 +546,9 @@ idFormSectionNoinput = "form-section-noinput"
 aformSection :: (MonadHandler m, site ~ HandlerSite m, RenderMessage site msg) => msg -> AForm m ()
 aformSection = formToAForm . fmap (second pure) . formSection
 
+wformSection :: (MonadHandler m, RenderMessage (HandlerSite m) msg) => msg -> WForm m ()
+wformSection = void . aFormToWForm . aformSection
+
 formSection :: (MonadHandler m, site ~ HandlerSite m, RenderMessage site msg) => msg -> MForm m (FormResult (), FieldView site) -- TODO: WIP, delete
 formSection formSectionTitle = do
     mr <- getMessageRender
@@ -663,23 +690,32 @@ mforced Field{..} FieldSettings{..} val = do
 
 aforced :: (RenderMessage site FormMessage, HandlerSite m ~ site, MonadHandler m)
         => Field m a -> FieldSettings site -> a -> AForm m a
-aforced field settings val = formToAForm $ second pure <$> mforced field settings val
-
-apreq :: (RenderMessage site FormMessage, HandlerSite m ~ site, MonadHandler m)
-      => Field m a -> FieldSettings site -> Maybe a -> AForm m a
--- ^ Pseudo required
-apreq f fs mx = formToAForm $ do
-  mr <- getMessageRender
-  over _1 (maybe (FormFailure [mr MsgValueRequired]) return =<<) . over _2 (pure . (\fv -> fv { fvRequired = True } )) <$> mopt f fs (Just <$> mx)
+aforced field settings val = formToAForm $ over _2 pure <$> mforced field settings val
 
 mpreq :: (RenderMessage site FormMessage, HandlerSite m ~ site, MonadHandler m)
       => Field m a -> FieldSettings site -> Maybe a -> MForm m (FormResult a, FieldView site)
+-- ^ Pseudo required
+--
+-- `FieldView` has `fvRequired` set to `True` and @FormSuccess Nothing@ is cast to `FormFailure`.
+-- Otherwise acts exactly like `mopt`.
 mpreq f fs mx = do
   mr <- getMessageRender
-  over _1 (maybe (FormFailure [mr MsgValueRequired]) return =<<) . over _2 (\fv -> fv { fvRequired = True } ) <$> mopt f fs (Just <$> mx)
+  (res, fv) <- mopt f fs (Just <$> mx)
+  let fv' = fv { fvRequired = True }
+  return $ case res of
+    FormSuccess (Just res')
+      -> (FormSuccess res', fv')
+    FormSuccess Nothing
+      -> (FormFailure [mr MsgValueRequired], fv' { fvErrors = Just . toHtml $ mr MsgValueRequired })
+    FormFailure errs
+      -> (FormFailure errs, fv')
+    FormMissing
+      -> (FormMissing, fv')
+
+apreq :: (RenderMessage site FormMessage, HandlerSite m ~ site, MonadHandler m)
+      => Field m a -> FieldSettings site -> Maybe a -> AForm m a
+apreq f fs mx = formToAForm $ over _2 pure <$> mpreq f fs mx
 
 wpreq :: (RenderMessage site FormMessage, HandlerSite m ~ site, MonadHandler m)
       => Field m a -> FieldSettings site -> Maybe a -> WForm m (FormResult a)
-wpreq f fs mx = mFormToWForm $ do
-  mr <- getMessageRender
-  over _1 (maybe (FormFailure [mr MsgValueRequired]) return =<<) . over _2 (\fv -> fv { fvRequired = True } ) <$> mopt f fs (Just <$> mx)
+wpreq f fs mx = mFormToWForm $ mpreq f fs mx
diff --git a/src/Utils/Frontend/Modal.hs b/src/Utils/Frontend/Modal.hs
index dd83497ea..94948aeba 100644
--- a/src/Utils/Frontend/Modal.hs
+++ b/src/Utils/Frontend/Modal.hs
@@ -11,8 +11,8 @@ import Utils.Route
 
 import Settings (widgetFile)
 
-import Control.Monad.Random.Class (MonadRandom(..))
-import qualified Data.UUID as UUID
+import Control.Monad.Random.Class (uniform)
+import Control.Monad.Trans.Random (evalRandTIO)
 
 
 data Modal site = Modal
@@ -47,8 +47,17 @@ msgModal :: WidgetT site IO ()
          -> Either (SomeRoute site) (WidgetT site IO ())
          -> WidgetT site IO ()
 msgModal modalTrigger' modalContent = do
-  modalTriggerId <- Just . UUID.toText <$> liftIO getRandom
-  modalId <- Just . UUID.toText <$> liftIO getRandom
+  let
+    randomIdentifier :: MonadIO m => m Text
+    -- ^ Generates valid CSS-Identifiers with roughly 128 bits of entropy
+    --
+    -- See https://www.w3.org/TR/CSS21/syndata.html#value-def-identifier
+    randomIdentifier = fmap pack . evalRandTIO $ do
+      prefix <- uniform $ ['a'..'z'] ++ ['A'..'Z']
+      suffix <- replicateM 21 . uniform $ ['a'..'z'] ++ ['A'..'Z'] ++ ['0'..'9']
+      return $ prefix : suffix
+  modalTriggerId <- Just <$> randomIdentifier
+  modalId <- Just <$> randomIdentifier
   customModal Modal{..}
   where
     modalTrigger mRoute triggerId = $(widgetFile "widgets/modal/trigger")
diff --git a/src/Utils/Lens.hs b/src/Utils/Lens.hs
index d52b852c8..b4cd5a572 100644
--- a/src/Utils/Lens.hs
+++ b/src/Utils/Lens.hs
@@ -77,6 +77,8 @@ hasEntityUser = hasEntity
 
 makeLenses_ ''SheetCorrector
 
+makeLenses_ ''Load
+
 makeLenses_ ''SubmissionGroup
 
 makeLenses_ ''SheetGrading
@@ -103,6 +105,8 @@ makePrisms ''HandlerContents
 
 makePrisms ''ErrorResponse
 
+makeLenses_ ''UploadMode
+
 makeLenses_ ''SubmissionMode
 
 makePrisms ''E.Value
diff --git a/src/Utils/PathPiece.hs b/src/Utils/PathPiece.hs
index c7434b54f..2d9b8b860 100644
--- a/src/Utils/PathPiece.hs
+++ b/src/Utils/PathPiece.hs
@@ -5,6 +5,7 @@ module Utils.PathPiece
   , splitCamel
   , camelToPathPiece, camelToPathPiece'
   , tuplePathPiece
+  , pathPieceJSONKey
   ) where
 
 import ClassyPrelude.Yesod
@@ -22,6 +23,8 @@ import qualified Data.Map as Map
 import Numeric.Natural
 
 import Data.List (foldl)
+
+import Data.Aeson.Types
   
 
 finiteFromPathPiece :: (PathPiece a, Finite a) => Text -> Maybe a
@@ -109,3 +112,13 @@ tuplePathPiece tupleDim = do
                          ]) []
       ]
     ]
+
+
+pathPieceJSONKey :: Name -> DecsQ
+-- ^ Derive `ToJSONKey`- and `FromJSONKey`-Instances from a `PathPiece`-Instance
+pathPieceJSONKey tName
+  = [d| instance ToJSONKey $(conT tName) where
+          toJSONKey = toJSONKeyText toPathPiece
+        instance FromJSONKey $(conT tName) where
+          fromJSONKey = FromJSONKeyTextParser $ \t -> maybe (fail $ "Could not parse ‘" <> unpack t <> "’ as value for " <> $(TH.lift $ nameBase tName) <> "via PathPiece") return $ fromPathPiece t
+      |]
diff --git a/src/Utils/Sheet.hs b/src/Utils/Sheet.hs
index 241947549..0fa7da74f 100644
--- a/src/Utils/Sheet.hs
+++ b/src/Utils/Sheet.hs
@@ -3,7 +3,7 @@ module Utils.Sheet where
 import Import.NoFoundation
 import qualified Database.Esqueleto as E
 
-import Database.Esqueleto.Internal.Language (From) -- How to avoid this import?
+import Database.Esqueleto.Internal.Language (From) -- cannot be avoided here
 
 -- DB Queries for Sheets that are used in several places
 
@@ -47,8 +47,8 @@ sheetOldUnassigned tid ssh csh = do
     _ -> error "SQL Query with limit 1 returned more than one result"
 
 -- | Return a specfic file from  a `Sheet`
-sheetFileQuery :: MonadIO m => TermId -> SchoolId -> CourseShorthand -> SheetName -> SheetFileType -> FilePath -> SqlReadT m [Entity File]
-sheetFileQuery tid ssh csh shn sft title = E.select $ E.from $
+sheetFileQuery :: MonadResource m => TermId -> SchoolId -> CourseShorthand -> SheetName -> SheetFileType -> FilePath -> Source (SqlPersistT m) (Entity File)
+sheetFileQuery tid ssh csh shn sft title = E.selectSource $ E.from $
   \(course `E.InnerJoin` sheet `E.InnerJoin` sFile `E.InnerJoin` file) -> do
   -- Restrict to consistent rows that correspond to each other
   E.on (file  E.^. FileId         E.==. sFile  E.^. SheetFileFile)
@@ -66,8 +66,8 @@ sheetFileQuery tid ssh csh shn sft title = E.select $ E.from $
   return file
 
 -- | Return all files of a certain `SheetFileType` for a `Sheet`
-sheetFilesAllQuery :: MonadIO m => TermId -> SchoolId -> CourseShorthand -> SheetName -> SheetFileType -> SqlReadT m [Entity File]
-sheetFilesAllQuery tid ssh csh shn sft = E.select $ E.from $
+sheetFilesAllQuery :: MonadResource m => TermId -> SchoolId -> CourseShorthand -> SheetName -> SheetFileType -> Source (SqlPersistT m) (Entity File)
+sheetFilesAllQuery tid ssh csh shn sft = E.selectSource $ E.from $
   \(course `E.InnerJoin` sheet `E.InnerJoin` sFile `E.InnerJoin` file) -> do
   -- Restrict to consistent rows that correspond to each other
   E.on (file  E.^. FileId         E.==. sFile  E.^. SheetFileFile)
@@ -85,9 +85,8 @@ sheetFilesAllQuery tid ssh csh shn sft = E.select $ E.from $
 
 -- | Check whether a sheet has any files for a given file type
 hasSheetFileQuery :: Database.Esqueleto.Internal.Language.From query expr backend (expr (Entity SheetFile))
--- hasSheetFileQuery :: (E.Esqueleto query expr backend)
   => expr (Entity Sheet) -> SheetFileType -> expr (E.Value Bool)
 hasSheetFileQuery sheet sft =
   E.exists $ E.from $ \sFile ->
     E.where_ ((sFile E.^. SheetFileSheet E.==. sheet E.^. SheetId)
-      E.&&.   (sFile E.^. SheetFileType  E.==. E.val sft  ))
\ No newline at end of file
+      E.&&.   (sFile E.^. SheetFileType  E.==. E.val sft  ))
diff --git a/stack.yaml b/stack.yaml
index 7fadc6e4e..02b25ee57 100644
--- a/stack.yaml
+++ b/stack.yaml
@@ -51,4 +51,6 @@ extra-deps:
 
   - systemd-1.2.0
 
+  - filepath-1.4.2
+
 resolver: lts-10.5
diff --git a/static/js/services/htmlHelpers.js b/static/js/services/htmlHelpers.js
new file mode 100644
index 000000000..30477314c
--- /dev/null
+++ b/static/js/services/htmlHelpers.js
@@ -0,0 +1,50 @@
+(function () {
+  'use strict';
+
+  window.HtmlHelpers = (function() {
+
+    // `parseResponse` takes a raw HttpClient response and an options object.
+    // Returns an object with `element` being an contextual fragment of the
+    // HTML in the response and `ifPrefix` being the prefix that was used to
+    // "unique-ify" the ids of the received HTML.
+    // Original Response IDs can optionally be kept by adding `keepIds: true`
+    // to the `options` object.
+    function parseResponse(response, options) {
+      options = options || {};
+
+      return response.text().then(function (responseText) {
+        var docFrag = document.createRange().createContextualFragment(responseText);
+        var idPrefix;
+        if (!options.keepIds) {
+          idPrefix = _getIdPrefix();
+          _prefixIds(docFrag, idPrefix);
+        }
+        return Promise.resolve({ idPrefix: idPrefix, element: docFrag });
+      },
+      function (error) {
+        return Promise.reject(error);
+      }).catch(function (error) { console.error(error); });
+    }
+
+    function _prefixIds(element, idPrefix) {
+      var idAttrs = ['id', 'for', 'data-conditional-input', 'data-modal-trigger'];
+
+      idAttrs.forEach(function(attr) {
+        Array.from(element.querySelectorAll('[' + attr + ']')).forEach(function(input) {
+          var value = idPrefix + input.getAttribute(attr);
+          input.setAttribute(attr, value);
+        });
+      });
+    }
+
+    function _getIdPrefix() {
+      // leading 'r'(andom) to overcome the fact that IDs
+      // starting with a numeric value are not valid in CSS
+      return 'r' + Math.floor(Math.random() * 100000) + '__';
+    }
+
+    return {
+      parseResponse: parseResponse,
+    }
+  })();
+})();
diff --git a/static/js/services/httpClient.js b/static/js/services/httpClient.js
index eacd9b6b5..f65fb0e3f 100644
--- a/static/js/services/httpClient.js
+++ b/static/js/services/httpClient.js
@@ -11,21 +11,23 @@
       }
     }
 
-    function _fetch(url, method, additionalHeaders, body) {
+    function _fetch(options) {
       var requestOptions = {
         credentials: 'same-origin',
         headers: { },
-        method: method,
-        body: body,
+        method: options.method,
+        body: options.body,
       };
 
-      Object.keys(additionalHeaders).forEach(function(headerKey) {
-        requestOptions.headers[headerKey] = additionalHeaders[headerKey];
+      Object.keys(options.headers).forEach(function(headerKey) {
+        requestOptions.headers[headerKey] = options.headers[headerKey];
       });
 
-      return fetch(url, requestOptions).then(
+      return fetch(options.url, requestOptions).then(
         function(response) {
-          _responseInterceptors.forEach(function(interceptor) { interceptor(response); });
+          _responseInterceptors.forEach(function(interceptor) {
+            interceptor(response, options);
+          });
           return Promise.resolve(response);
         },
         function(error) {
@@ -37,13 +39,34 @@
     }
 
     return {
-      get: function(url, headers) {
-        return _fetch(url, 'GET', headers);
+      get: function(args) {
+        args.method = 'GET';
+        return _fetch(args);
       },
-      post: function(url, headers, body) {
-        return _fetch(url, 'POST', headers, body);
+      post: function(args) {
+        args.method = 'POST';
+        return _fetch(args);
       },
       addResponseInterceptor: addResponseInterceptor,
+      ACCEPT: {
+        TEXT_HTML: 'text/html',
+        JSON: 'application/json',
+      },
     }
   })();
+
+  // HttpClient ships with its own little interceptor to throw an error
+  // if the response does not match the expected content-type
+  function contentTypeInterceptor(response, options) {
+    if (!options || !options.accept) {
+      return;
+    }
+
+    var contentType = response.headers.get("content-type");
+    if (!contentType.match(options.accept)) {
+      throw new Error('Server returned with "' + contentType + '" when "' + options.accept + '" was expected');
+    }
+  }
+
+  HttpClient.addResponseInterceptor(contentTypeInterceptor);
 })();
diff --git a/static/js/utils/alerts.js b/static/js/utils/alerts.js
index 52f620d12..427e38373 100644
--- a/static/js/utils/alerts.js
+++ b/static/js/utils/alerts.js
@@ -160,7 +160,8 @@
       var alerts;
       for (var header of response.headers) {
         if (header[0] === 'alerts') {
-          alerts = JSON.parse(header[1]);
+          var decodedHeader = decodeURIComponent(header[1]);
+          alerts = JSON.parse(decodedHeader);
           break;
         }
       }
diff --git a/static/js/utils/asyncForm.js b/static/js/utils/asyncForm.js
index eaf6f9221..4750a7e57 100644
--- a/static/js/utils/asyncForm.js
+++ b/static/js/utils/asyncForm.js
@@ -96,21 +96,21 @@
         headers[MODAL_HEADER_KEY] = MODAL_HEADER_VALUE;
       }
 
-      HttpClient.post(url, headers, body)
-        .then(function(response) {
-          if (response.headers.get("content-type").indexOf("application/json") !== -1) {// checking response header
-            return response.json();
-          } else {
-            throw new TypeError('Unexpected Content-Type. Expected Content-Type: "application/json". Requested URL:' + url + '"');
-          }
-        }).then(function(response) {
-          processResponse(response[0]);
-        }).catch(function(error) {
-          var failureMessage = I18n.get('asyncFormFailure');
-          processResponse({ content: failureMessage });
+      HttpClient.post({
+        url: url,
+        headers: headers,
+        body: body,
+        accept: HttpClient.ACCEPT.JSON,
+      }).then(function(response) {
+        return response.json();
+      }).then(function(response) {
+        processResponse(response[0]);
+      }).catch(function(error) {
+        var failureMessage = I18n.get('asyncFormFailure');
+        processResponse({ content: failureMessage });
 
-          element.classList.remove(ASYNC_FORM_LOADING_CLASS);
-        });
+        element.classList.remove(ASYNC_FORM_LOADING_CLASS);
+      });
     }
 
     return init();
diff --git a/static/js/utils/asyncTable.js b/static/js/utils/asyncTable.js
index 13598904b..ccc441038 100644
--- a/static/js/utils/asyncTable.js
+++ b/static/js/utils/asyncTable.js
@@ -35,6 +35,7 @@
     var pageLinks = [];
     var pagesizeForm;
     var scrollTable;
+    var cssIdPrefix = '';
 
     var tableFilterInputs = {
       search: [],
@@ -48,12 +49,18 @@
         throw new Error('Async Table utility cannot be setup without an element!');
       }
 
+      if (element.classList.contains(ASYNC_TABLE_INITIALIZED_CLASS)) {
+        return false;
+      }
+
       // param asyncTableDbHeader
       if (element.dataset.asyncTableDbHeader !== undefined) {
         asyncTableHeader = element.dataset.asyncTableDbHeader;
       }
 
-      asyncTableId = element.querySelector('table').id;
+      var rawTableId = element.querySelector('table').id;
+      cssIdPrefix = findCssIdPrefix(rawTableId);
+      asyncTableId = rawTableId.replace(cssIdPrefix, '');
 
       // find scrolltable wrapper
       scrollTable = element.querySelector(ASYNC_TABLE_SCROLLTABLE_SELECTOR);
@@ -96,7 +103,7 @@
     }
 
     function setupPagination() {
-      var pagination = element.querySelector('#' + asyncTableId + '-pagination');
+      var pagination = element.querySelector('#' + cssIdPrefix + asyncTableId + '-pagination');
       if (pagination) {
         pageLinks = Array.from(pagination.querySelectorAll('.page-link')).map(function(link) {
           return { element: link };
@@ -122,7 +129,7 @@
 
     function setupPageSizeSelect() {
       // pagesize form
-      pagesizeForm = element.querySelector('#' + asyncTableId + '-pagesize-form');
+      pagesizeForm = element.querySelector('#' + cssIdPrefix + asyncTableId + '-pagesize-form');
 
       if (pagesizeForm) {
         var pagesizeSelect = pagesizeForm.querySelector('[name=' + asyncTableId + '-pagesize]');
@@ -200,11 +207,15 @@
 
       var focusedInput = tableFilterForm.querySelector(':focus, :active');
       // focus previously focused input
-      if (focusedInput) {
+      if (focusedInput && focusedInput.selectionStart !== null) {
         var selectionStart = focusedInput.selectionStart;
-        var focusId = focusedInput.id;
+        // remove the following part of the id to get rid of the random
+        // (yet somewhat structured) prefix we got from nudging.
+        var prefix = findCssIdPrefix(focusedInput.id);
+        var focusId = focusedInput.id.replace(prefix, '');
         callback = function(wrapper) {
-          var toBeFocused = wrapper.querySelector('#' + focusId);
+          var idPrefix = getLocalStorageParameter('cssIdPrefix');
+          var toBeFocused = wrapper.querySelector('#' + idPrefix + focusId);
           if (toBeFocused) {
             toBeFocused.focus();
             toBeFocused.selectionStart = selectionStart;
@@ -298,11 +309,19 @@
     }
 
     function changePagesizeHandler(event) {
+      var paginationParamKey = asyncTableId + '-pagination';
       var pagesizeParamKey = asyncTableId + '-pagesize';
       var pageParamKey = asyncTableId + '-page';
+
+      var paginationParamEl = pagesizeForm.querySelector('[name="' + paginationParamKey + '"]');
       var url = new URL(getLocalStorageParameter('currentTableUrl') || window.location.href);
       url.searchParams.set(pagesizeParamKey, event.target.value);
       url.searchParams.set(pageParamKey, 0);
+
+      if (paginationParamEl) {
+        var encodedValue = encodeURIComponent(paginationParamEl.value);
+        url.searchParams.set(paginationParamKey, encodedValue);
+      }
       updateTableFrom(url.href);
     }
 
@@ -319,44 +338,56 @@
         [asyncTableHeader]: asyncTableId
       };
 
-      HttpClient.get(url, headers).then(function(response) {
-        if (!response.ok) {
-          throw new Error('Looks like there was a problem fetching ' + url.href + '. Status Code: ' + response.status);
-        }
-        return response.text();
-      }).then(function(data) {
+      HttpClient.get({
+        url: url,
+        headers: headers,
+        accept: HttpClient.ACCEPT.TEXT_HTML,
+      }).then(function(response) {
+        return HtmlHelpers.parseResponse(response);
+      }).then(function(response) {
         setLocalStorageParameter('currentTableUrl', url.href);
         // reset table
         removeListeners();
         element.classList.remove(ASYNC_TABLE_INITIALIZED_CLASS);
         // update table with new
-        updateWrapperContents(data);
+        updateWrapperContents(response);
 
-        if (callback && typeof callback === 'function') {
-          callback(element);
+        if (UtilRegistry) {
+          UtilRegistry.setupAll(element);
         }
 
-        element.classList.remove(ASYNC_TABLE_LOADING_CLASS);
+        if (callback && typeof callback === 'function') {
+          setLocalStorageParameter('cssIdPrefix', response.idPrefix);
+          callback(element);
+          setLocalStorageParameter('cssIdPrefix', '');
+        }
       }).catch(function(err) {
         console.error(err);
+      }).finally(function() {
         element.classList.remove(ASYNC_TABLE_LOADING_CLASS);
       });
     }
 
-    function updateWrapperContents(newHtml) {
+    function updateWrapperContents(response) {
       var newPage = document.createElement('div');
-      newPage.innerHTML = newHtml;
-      var newWrapperContents = newPage.querySelector('#' + element.id);
+      newPage.appendChild(response.element);
+      var newWrapperContents = newPage.querySelector('#' + response.idPrefix + element.id);
       element.innerHTML = newWrapperContents.innerHTML;
-
-      if (UtilRegistry) {
-        UtilRegistry.setupAll(element);
-      }
     }
 
     return init();
   };
 
+  // returns any random nudged prefix found in the given id
+  function findCssIdPrefix(id) {
+    var matcher = /r\d*?__/;
+    var maybePrefix = id.match(matcher);
+    if (maybePrefix && maybePrefix[0]) {
+      return maybePrefix[0]
+    }
+    return '';
+  }
+
   function setLocalStorageParameter(key, value) {
     var currentLSState = JSON.parse(window.localStorage.getItem(ASYNC_TABLE_LOCAL_STORAGE_KEY)) || {};
     if (value !== null) {
diff --git a/static/js/utils/checkAll.js b/static/js/utils/checkAll.js
index 5a15e0ac7..1c207be34 100644
--- a/static/js/utils/checkAll.js
+++ b/static/js/utils/checkAll.js
@@ -30,6 +30,10 @@
         throw new Error('Check All utility cannot be setup without an element!');
       }
 
+      if (element.classList.contains(CHECK_ALL_INITIALIZED_CLASS)) {
+        return false;
+      }
+
       gatherColumns();
       setupCheckAllCheckbox();
 
diff --git a/static/js/utils/form.js b/static/js/utils/form.js
index da02abd5d..ed8b0fa9a 100644
--- a/static/js/utils/form.js
+++ b/static/js/utils/form.js
@@ -247,6 +247,88 @@
     setup: interactiveFieldsetUtil,
   });
 
+  /**
+   *
+   * Navigate Away Prompt Utility
+   *  This utility asks the user if (s)he really wants to navigate away
+   *  from a page containing a form if (s)he already touched an input.
+   *  Form-Submits will not trigger the prompt.
+   *  Utility will ignore forms that contain auto submit elements (buttons, inputs).
+   *
+   * Attribute: [none]
+   *  (automatically setup on all form tags that dont automatically submit, see AutoSubmitButtonUtil)
+   *
+   * Example usage:
+   *  (any page with a form)
+   */
+
+  var NAVIGATE_AWAY_PROMPT_UTIL_NAME = 'navigateAwayPrompt';
+  var NAVIGATE_AWAY_PROMPT_UTIL_SELECTOR = 'form';
+
+  var NAVIGATE_AWAY_PROMPT_INITIALIZED_CLASS = 'navigate-away-prompt--initialized';
+
+  var navigateAwayPromptUtil = function(element) {
+    var touched = false;
+    var unloadDueToSubmit = false;
+
+    function init() {
+      if (!element) {
+        throw new Error('Navigate Away Prompt utility needs to be passed an element!');
+      }
+
+      if (element.classList.contains(NAVIGATE_AWAY_PROMPT_INITIALIZED_CLASS)) {
+        return false;
+      }
+
+      // ignore forms that get submitted automatically
+      if (element.querySelector(AUTO_SUBMIT_BUTTON_UTIL_SELECTOR) || element.querySelector(AUTO_SUBMIT_INPUT_UTIL_SELECTOR)) {
+        return false;
+      }
+
+      window.addEventListener('beforeunload', beforeUnloadHandler);
+
+      element.addEventListener('submit', function() {
+        unloadDueToSubmit = true;
+      });
+      element.addEventListener('change', function() {
+        touched = true;
+        unloadDueToSubmit = false;
+      });
+
+      // mark initialized
+      element.classList.add(NAVIGATE_AWAY_PROMPT_INITIALIZED_CLASS);
+
+      return {
+        name: NAVIGATE_AWAY_PROMPT_UTIL_NAME,
+        element: element,
+        destroy: function() {
+          window.removeEventListener('beforeunload', beforeUnloadHandler);
+        },
+      };
+    }
+
+    function beforeUnloadHandler(event) {
+      // allow the event to happen if the form was not touched by the
+      // user or the unload event was initiated by a form submit
+      if (!touched || unloadDueToSubmit) {
+        return false;
+      }
+
+      // cancel the unload event. This is the standard to force the prompt to appear.
+      event.preventDefault();
+      // for all non standard compliant browsers we return a truthy value to activate the prompt.
+      return true;
+    }
+
+    return init();
+  };
+
+  formUtilities.push({
+    name: NAVIGATE_AWAY_PROMPT_UTIL_NAME,
+    selector: NAVIGATE_AWAY_PROMPT_UTIL_SELECTOR,
+    setup: navigateAwayPromptUtil,
+  });
+
   /**
    *
    * Auto Submit Button Utility
@@ -270,6 +352,10 @@
       throw new Error('Auto Submit Button utility needs to be passed an element!');
     }
 
+    if (element.classList.contains(AUTO_SUBMIT_BUTTON_INITIALIZED_CLASS)) {
+      return false;
+    }
+
     // hide and mark initialized
     element.classList.add(AUTO_SUBMIT_BUTTON_HIDDEN_CLASS, AUTO_SUBMIT_BUTTON_INITIALIZED_CLASS);
 
@@ -315,6 +401,10 @@
         throw new Error('Auto Submit Input utility needs to be passed an element!');
       }
 
+      if (element.classList.contains(AUTO_SUBMIT_INPUT_INITIALIZED_CLASS)) {
+        return false;
+      }
+
       form = element.form;
       if (!form) {
         throw new Error('Could not determine associated form for auto submit input');
@@ -374,6 +464,10 @@
         throw new Error('Form Error Remover utility needs to be passed an element!');
       }
 
+      if (element.classList.contains(FORM_ERROR_REMOVER_INITIALIZED_CLASS)) {
+        return false;
+      }
+
       // find form groups
       formGroups = Array.from(element.querySelectorAll(FORM_GROUP_SELECTOR));
 
@@ -428,6 +522,8 @@
   var DATEPICKER_UTIL_NAME = 'datepicker';
   var DATEPICKER_UTIL_SELECTOR = 'input[type="date"], input[type="time"], input[type="datetime-local"]';
 
+  var DATEPICKER_INITIALIZED_CLASS = 'datepicker--initialized';
+
   var DATEPICKER_CONFIG = {
     "datetime-local": {
       enableTime: true,
@@ -459,6 +555,10 @@
         throw new Error('Datepicker utility needs to be passed an element!');
       }
 
+      if (element.classList.contains(DATEPICKER_INITIALIZED_CLASS)) {
+        return false;
+      }
+
       var flatpickrConfig = DATEPICKER_CONFIG[element.getAttribute("type")];
 
       if (!flatpickrConfig) {
@@ -467,6 +567,9 @@
 
       flatpickrInstance = flatpickr(element, flatpickrConfig);
 
+      // mark initialized
+      element.classList.add(DATEPICKER_INITIALIZED_CLASS);
+
       return {
         name: DATEPICKER_UTIL_NAME,
         element: element,
diff --git a/static/js/utils/massInput.js b/static/js/utils/massInput.js
index 5d75a7c6c..8dbccdca3 100644
--- a/static/js/utils/massInput.js
+++ b/static/js/utils/massInput.js
@@ -38,6 +38,10 @@
         throw new Error('Mass Input utility cannot be setup without an element!');
       }
 
+      if (element.classList.contains(MASS_INPUT_INITIALIZED_CLASS)) {
+        return false;
+      }
+
       massInputId = element.dataset.massInputIdent || '_';
       massInputForm = element.closest('form');
 
@@ -120,19 +124,20 @@
 
           if (enctype !== 'multipart/form-data')
             headers['Content-Type'] = enctype;
-          
-          requestFn(
-            url,
-            headers,
-            requestBody,
-          ).then(function(response) {
-            return response.text();
+
+          requestFn({
+            url: url,
+            headers: headers,
+            body: requestBody,
+            accept: HttpClient.ACCEPT.TEXT_HTML,
           }).then(function(response) {
-            processResponse(response);
-            if (isAddCell) {
-              reFocusAddCell();
-            }
-          });
+            return HtmlHelpers.parseResponse(response);
+          }).then(function(response) {
+              processResponse(response.element);
+              if (isAddCell) {
+                reFocusAddCell();
+              }
+            });
         }
       };
     }
@@ -163,27 +168,17 @@
       button.removeEventListener('click', massInputFormSubmitHandler);
     }
 
-    function processResponse(response) {
-      element.innerHTML = response;
+    function processResponse(responseElement) {
+      element.innerHTML = "";
+      element.appendChild(responseElement);
 
-      prefixInputIds();
-      reset()
+      reset();
 
       if (UtilRegistry) {
         UtilRegistry.setupAll(element);
       }
     }
 
-    function prefixInputIds() {
-      var idAttrs = ['id', 'for', 'data-conditional-input'];
-      idAttrs.forEach(function(attr) {
-        Array.from(element.querySelectorAll('[' + attr + ']')).forEach(function(input) {
-          var value = element.id + '__' + input.getAttribute(attr);
-          input.setAttribute(attr, value);
-        });
-      });
-    }
-
     function serializeForm(submitButton, enctype) {
       var formData = new FormData(massInputForm);
 
diff --git a/static/js/utils/modal.js b/static/js/utils/modal.js
index de6fee9d6..6710c0854 100644
--- a/static/js/utils/modal.js
+++ b/static/js/utils/modal.js
@@ -167,16 +167,18 @@
         throw new Error('HttpClient not found! Can\'t fetch modal content from ' + url);
       }
 
-      HttpClient.get(url, MODAL_HEADERS)
-        .then(function(response) {
-          response.text().then(processResponse);
-        });
+      HttpClient.get({
+        url: url,
+        headers: MODAL_HEADERS,
+        accept: HttpClient.ACCEPT.TEXT_HTML,
+      }).then(function(response) {
+        return HtmlHelpers.parseResponse(response);
+      }).then(function(response) {
+        processResponse(response.element);
+      });
     }
 
-    function processResponse(responseBody) {
-      var responseElement = document.createElement('div');
-      responseElement.innerHTML = responseBody;
-
+    function processResponse(responseElement) {
       var modalContent = document.createElement('div');
       modalContent.classList.add(MODAL_CONTENT_CLASS);
 
@@ -191,24 +193,12 @@
         previousModalContent.remove();
       }
 
-      modalContent = withPrefixedInputIDs(modalContent);
       element.insertBefore(modalContent, null);
 
       // setup any newly arrived utils
       UtilRegistry.setupAll(element);
     }
 
-    function withPrefixedInputIDs(modalContent) {
-      var idAttrs = ['id', 'for', 'data-conditional-input'];
-      idAttrs.forEach(function(attr) {
-        Array.from(modalContent.querySelectorAll('[' + attr + ']')).forEach(function(input) {
-          var value = element.id + '__' + input.getAttribute(attr);
-          input.setAttribute(attr, value);
-        });
-      });
-      return modalContent;
-    }
-
     return _init();
   };
 
diff --git a/templates/default-layout.lucius b/templates/default-layout.lucius
index 558ee6e0d..644ad3d11 100644
--- a/templates/default-layout.lucius
+++ b/templates/default-layout.lucius
@@ -465,6 +465,17 @@ ul.list--inline {
   }
 }
 
+.list--space-separated li {
+  &::after {
+    content: ' ';
+    white-space: pre;
+  }
+
+  &:last-of-type::after {
+    content: none;
+  }
+}
+
 /* DEFINITION LIST */
 .deflist {
   display: grid;
diff --git a/templates/i18n/README_i18n.txt b/templates/i18n/README_i18n.txt
new file mode 100644
index 000000000..9915cdd0b
--- /dev/null
+++ b/templates/i18n/README_i18n.txt
@@ -0,0 +1,6 @@
+This directories contains all language dependent widgets.
+
+Each widget requires its own directories, the name of which is needed in the source code, e.g. for directory "imprint"
+  $(i18nWidgetFile "imprint")
+inside this directory must be one file per language "de.hamlet", etc. 
+
diff --git a/templates/messages/submissionFilesIgnored.hamlet b/templates/messages/submissionFilesIgnored.hamlet
index ebb61695e..628125d9f 100644
--- a/templates/messages/submissionFilesIgnored.hamlet
+++ b/templates/messages/submissionFilesIgnored.hamlet
@@ -1,4 +1,4 @@
-_{MsgSubmissionFilesIgnored}
+
_{MsgSubmissionFilesIgnored (Set.size ignoredFiles)}