feat(course): introduce CourseNews

messages/uniworx/de.msg

@@ -36,6 +36,9 @@ RegisterTo: Anmeldungen bis
 DeRegUntil: Abmeldungen bis
 RegisterRetry: Sie wurden noch nicht angemeldet. Drücken Sie dazu den Knopf "Anmelden"
 
+CourseRegistrationInterval: Anmeldezeitraum
+CourseDeregisterUntil time@Text: Abmeldung nur bis #{time}
+
 GenericKey: Schlüssel
 GenericShort: Kürzel
 GenericIsNew: Neu
@@ -378,12 +381,14 @@ UnauthorizedRegistered: Sie sind nicht als Teilnehmer für diese Veranstaltung r
 UnauthorizedAllocationRegistered: Sie sind nicht als Teilnehmer für diese Zentralanmeldung registriert.
 UnauthorizedExamResult: Sie haben keine Ergebnisse in dieser Prüfung.
 UnauthorizedParticipant: Angegebener Benutzer ist nicht als Teilnehmer dieser Veranstaltung registriert.
+UnauthorizedCourseNewsParticipant: Sie sind kein Teilnehmer dieser Veranstaltung.
 UnauthorizedCourseTime: Dieses Kurs erlaubt momentan keine Anmeldungen.
 UnauthorizedAllocationRegisterTime: Diese Zentralanmeldung erlaubt momentan keine Bewerbungen.
 UnauthorizedSheetTime: Dieses Übungsblatt ist momentan nicht freigegeben.
 UnauthorizedApplicationTime: Diese Bewerbung ist momentan nicht freigegeben.
 UnauthorizedMaterialTime: Dieses Material ist momentan nicht freigegeben.
 UnauthorizedTutorialTime: Dieses Tutorium erlaubt momentan keine Anmeldungen.
+UnauthorizedCourseNewsTime: Diese Nachricht ist momentan nicht freigegeben.
 UnauthorizedExamTime: Diese Prüfung ist momentan nicht freigegeben.
 UnauthorizedSubmissionOwner: Sie sind an dieser Abgabe nicht beteiligt.
 UnauthorizedSubmissionRated: Diese Abgabe ist noch nicht korrigiert.
@@ -1021,7 +1026,7 @@ MenuAllocationList: Zentralanmeldungen
 MenuCourseList: Kurse
 MenuCourseMembers: Kursteilnehmer
 MenuCourseAddMembers: Kursteilnehmer hinzufügen
-MenuCourseCommunication: Kursmitteilung
+MenuCourseCommunication: Kursmitteilung (E-Mail)
 MenuCourseApplications: Bewerbungen
 MenuCourseExamOffice: Prüfungsämter
 MenuTermShow: Semester
@@ -1085,6 +1090,8 @@ MenuAllocationInfo: Hinweise zum Ablauf einer Zentralanmeldung
 MenuCourseApplicationsFiles: Dateien aller Bewerbungen
 MenuSchoolList: Institute
 MenuSchoolNew: Neues Institut anlegen
+MenuCourseNewsNew: Neue Kursnachricht
+MenuCourseNewsEdit: Kursnachricht bearbeiten
 
 AuthPredsInfo: Um eigene Veranstaltungen aus Sicht der Teilnehmer anzusehen, können Veranstalter und Korrektoren hier die Prüfung ihrer erweiterten Berechtigungen temporär deaktivieren. Abgewählte Prädikate schlagen immer fehl. Abgewählte Prädikate werden also nicht geprüft um Zugriffe zu gewähren, welche andernfalls nicht erlaubt wären. Diese Einstellungen gelten nur temporär bis Ihre Sitzung abgelaufen ist, d.h. bis ihr Browser-Cookie abgelaufen ist. Durch Abwahl von Prädikaten kann man sich höchstens temporär aussperren.
 AuthPredsActive: Aktive Authorisierungsprädikate
@@ -1124,6 +1131,7 @@ AuthTagRead: Zugriff ist nur lesend
 AuthTagWrite: Zugriff ist i.A. schreibend
 
 DeleteCopyStringIfSure n@Int: Wenn Sie sich sicher sind, dass Sie #{pluralDE n "das obige Objekt" "obige Objekte"} unwiderbringlich löschen möchten, schreiben Sie bitte zunächst den angezeigten Text ab.
+DeletePressButtonIfSure n@Int: Wenn Sie sich sicher sind, dass Sie #{pluralDE n "das obige Objekt" "obige Objekte"} unwiderbringlich löschen möchten, bestätigen Sie dies bitte durch Drücken des untigen Knopfes.
 DeleteConfirmation: Bestätigung
 DeleteConfirmationWrong: Bestätigung muss genau dem angezeigten Text entsprechen.
 
@@ -1289,6 +1297,9 @@ HealthSMTPConnect: SMTP-Server kann erreicht werden
 HealthWidgetMemcached: Memcached-Server liefert Widgets korrekt aus
 HealthActiveJobExecutors: Anteil der job-workers, die neue Befehle annehmen
 
+CourseParticipantsHeading: Kursteilnehmer
+CourseParticipantsCount n@Int: #{n}
+CourseParticipantsCountOf n@Int m@Int: #{n} von #{m}
 CourseParticipants n@Int: Derzeit #{n} angemeldete Kursteilnehmer
 CourseParticipantsInvited n@Int: #{n} #{pluralDE n "Einladung" "Einladungen"} per E-Mail verschickt
 CourseParticipantsAlreadyRegistered n@Int: #{n} Teilnehmer #{pluralDE n "ist" "sind"} bereits angemeldet
@@ -1823,4 +1834,28 @@ CsvQuoteNone: Nie
 CsvQuoteMinimal: Nur wenn nötig
 CsvQuoteAll: Immer
 CsvOptionsUpdated: CSV-Optionen erfolgreich angepasst
-CsvChangeOptionsLabel: Export-Optionen
+CsvChangeOptionsLabel: Export-Optionen
+
+CourseNews: Aktuelles
+CourseNewsArchiveName tid@TermId ssh@SchoolId csh@CourseShorthand newsTitle@Text: #{foldCase (termToText (unTermKey tid))}-#{foldedCase (unSchoolKey ssh)}-#{foldedCase csh}-#{foldCase newsTitle}
+CourseNewsFiles: Dateien
+CourseNewsLastEdited time@Text: Zuletzt verändert: #{time}
+CourseNewsActionEdit: Bearbeiten
+CourseNewsActionDelete: Löschen
+CourseNewsActionCreate: Neue Nachricht
+CourseMaterial: Material
+CourseMaterialFree: Das Kursmaterial ist ohne Anmeldung frei zugänglich
+CourseMaterialNotFree: Eine Anmeldung zum Kurs ist Voraussetzung zum Zugang zu Kursmaterial
+
+CourseNewsVisibleFromEditWarning: Das Datum der Veröffentlichung liegt in der Vergangenheit und sollte nicht mehr verändert werden, da dies die Teilnehmer verwirren könnte.
+CourseNewsVisibleFromTip: Ohne Datum nie sichtbar für Teilnehmer; leer lassen ist nur sinnvoll für noch unfertige Nachrichten
+CourseNewsTitle: Titel
+CourseNewsSummary: Zusammenfassung
+CourseNewsSummaryTip: Wenn angegeben, wird auf der Kursübersichtsseite, platzsparend, nur die Zusammenfassung angezeigt und der Inhalt in ein Popup ausgelagert
+CourseNewsContent: Inhalt
+CourseNewsParticipantsOnly: Nur für Kursteilnehmer
+CourseNewsVisibleFrom: Sichtbar ab
+CourseNewsCreated: Kursnachricht erfolgreich angelegt
+CourseNewsEdited: Kursnachricht erfolgreich editiert
+CourseNewsDeleteQuestion: Wollen Sie die unten aufgeführte Nachricht wirklich löschen?
+CourseNewsDeleted: Kursnachricht erfolgreich gelöscht

models/courses.model

@@ -76,20 +76,3 @@ CourseUserExamOfficeOptOut
     user         UserId
     school       SchoolId
     UniqueCourseUserExamOfficeOptOut course user school
-
-CourseApplication
-    course              CourseId
-    user                UserId
-    field               StudyFeaturesId Maybe -- associated degree course, user-defined; required for communicating grades
-    text                Text            Maybe -- free text entered by user
-    ratingVeto          Bool                  default=false
-    ratingPoints        ExamGrade       Maybe
-    ratingComment       Text            Maybe
-    allocation          AllocationId    Maybe
-    allocationPriority  Natural         Maybe
-    time                UTCTime               default=now()
-    ratingTime          UTCTime         Maybe
-CourseApplicationFile 
-    application         CourseApplicationId
-    file                FileId
-    UniqueApplicationFile application file

models/courses/applications.model

@@ -0,0 +1,16 @@
+CourseApplication
+    course              CourseId
+    user                UserId
+    field               StudyFeaturesId Maybe -- associated degree course, user-defined; required for communicating grades
+    text                Text            Maybe -- free text entered by user
+    ratingVeto          Bool                  default=false
+    ratingPoints        ExamGrade       Maybe
+    ratingComment       Text            Maybe
+    allocation          AllocationId    Maybe
+    allocationPriority  Natural         Maybe
+    time                UTCTime               default=now()
+    ratingTime          UTCTime         Maybe
+CourseApplicationFile 
+    application         CourseApplicationId
+    file                FileId
+    UniqueApplicationFile application file

models/courses/materials.model

@@ -9,4 +9,5 @@ Material -- course material for disemination to course participants
   deriving Generic
 MaterialFile -- a file that is part of a material distribution
   material MaterialId
-  file     FileId
+  file     FileId
+  UniqueMaterialFile material file

models/courses/news.model

@@ -0,0 +1,12 @@
+CourseNews
+    course              CourseId
+    visibleFrom         UTCTime Maybe
+    participantsOnly    Bool
+    title               Text Maybe
+    content             Html
+    summary             Html Maybe
+    lastEdit            UTCTime
+CourseNewsFile
+    news                CourseNewsId
+    file                FileId
+    UniqueCourseNewsFile news file

package.yaml

@@ -138,6 +138,7 @@ dependencies:
   - deepseq
   - multiset
   - retry
+  - generic-lens
 
 other-extensions:
   - GeneralizedNewtypeDeriving
@@ -202,6 +203,7 @@ ghc-options:
   - -fno-warn-partial-type-signatures
   - -fno-max-relevant-binds
   - -j
+  - -freduction-depth=0
 
 when:
   - condition: flag(pedantic)

routes

@@ -179,6 +179,13 @@
   /apps/#CryptoFileNameCourseApplication CourseApplicationR:
     /                           CAEditR        GET POST        !timeANDself !lecturerANDstaff-time !selfANDread
     /files                      CAFilesR       GET             !self !lecturerANDstaff-time
+  !/news/add                    CNewsNewR      GET POST
+  /news/#CryptoUUIDCourseNews CourseNewsR:
+    /                           CNShowR        GET             !timeANDparticipant
+    /edit                       CNEditR        GET POST
+    /delete                     CNDeleteR      GET POST
+    !/download                  CNArchiveR     GET             !timeANDparticipant
+    !/download/*FilePath        CNFileR        GET             !timeANDparticipant
 
 /subs          CorrectionsR          GET POST !corrector !lecturer
 /subs/upload   CorrectionsUploadR    GET POST !corrector !lecturer

src/CryptoID.hs

@@ -48,6 +48,7 @@ decCryptoIDs [ ''SubmissionId
              , ''AllocationId
              , ''CourseApplicationId
              , ''CourseId
+             , ''CourseNewsId
              ]
 
 -- CryptoIDNamespace (CI FilePath) SubmissionId ~ "Submission"

src/Foundation.hs

@@ -156,8 +156,20 @@ deriving instance Generic CourseApplicationR
 deriving instance Generic AllocationR
 deriving instance Generic SchoolR
 deriving instance Generic ExamOfficeR
+deriving instance Generic CourseNewsR
 deriving instance Generic (Route UniWorX)
 
+data RouteChildren
+type instance Children RouteChildren a = ChildrenRouteChildren a
+type family ChildrenRouteChildren a where
+  ChildrenRouteChildren (Route EmbeddedStatic) = '[]
+  ChildrenRouteChildren (Route Auth) = '[]
+  ChildrenRouteChildren UUID = '[]
+  ChildrenRouteChildren (Key a) = '[]
+  ChildrenRouteChildren (CI a) = '[]
+
+  ChildrenRouteChildren a = Children ChGeneric a
+
 -- | Convenient Type Synonyms:
 type DB = YesodDB UniWorX
 type Form x = Html -> MForm (HandlerFor UniWorX) (FormResult x, Widget)
@@ -188,6 +200,10 @@ pattern CSubmissionR tid ssh csh shn cid ptn
 pattern CApplicationR :: TermId -> SchoolId -> CourseShorthand -> CryptoFileNameCourseApplication -> CourseApplicationR -> Route UniWorX
 pattern CApplicationR tid ssh csh appId ptn
   = CourseR tid ssh csh (CourseApplicationR appId ptn)
+  
+pattern CNewsR :: TermId -> SchoolId -> CourseShorthand -> CryptoUUIDCourseNews -> CourseNewsR -> Route UniWorX
+pattern CNewsR tid ssh csh nId ptn
+  = CourseR tid ssh csh (CourseNewsR nId ptn)
 
 
 pluralDE :: (Eq a, Num a)
@@ -934,6 +950,13 @@ tagAccessPredicate AuthTime = APDB $ \mAuthId route _ -> case route of
          && NTop systemMessageTo   >= cTime
     return Authorized
 
+  CNewsR _ _ _ cID _ -> maybeT (unauthorizedI MsgUnauthorizedCourseNewsTime) $ do
+    nId <- catchIfMaybeT (const True :: CryptoIDError -> Bool) $ decrypt cID
+    CourseNews{courseNewsVisibleFrom} <- $cachedHereBinary nId . MaybeT $ get nId
+    cTime <- (NTop . Just) <$> liftIO getCurrentTime
+    guard $ NTop courseNewsVisibleFrom <= cTime
+    return Authorized
+
   r -> $unsupportedAuthPredicate AuthTime r
 tagAccessPredicate AuthStaffTime = APDB $ \_ route isWrite -> case route of
   CApplicationR tid ssh csh _ _ -> maybeT (unauthorizedI MsgUnauthorizedApplicationTime) $ do
@@ -1104,81 +1127,96 @@ tagAccessPredicate AuthAllocationRegistered = APDB $ \mAuthId route _ -> case ro
     void . MaybeT . $cachedHereBinary (uid, aId) . getKeyBy $ UniqueAllocationUser aId uid
     return Authorized
   r -> $unsupportedAuthPredicate AuthAllocationRegistered r
-tagAccessPredicate AuthParticipant = APDB $ \_ route _ -> case route of
+tagAccessPredicate AuthParticipant = APDB $ \mAuthId route _ -> case route of
-  CourseR tid ssh csh (CUserR cID) -> exceptT return return $ do
+  CNewsR tid ssh csh cID _ -> maybeT (unauthorizedI MsgUnauthorizedCourseNewsParticipant) $ do
-    cTime <- liftIO getCurrentTime
+    uid <- hoistMaybe mAuthId
-    let
+    nId <- catchIfMaybeT (const True :: CryptoIDError -> Bool) $ decrypt cID
-      authorizedIfExists :: E.From a => (a -> E.SqlQuery b) -> ExceptT AuthResult DB ()
+    CourseNews{courseNewsParticipantsOnly} <- $cachedHereBinary nId . MaybeT $ get nId
-      authorizedIfExists = flip whenExceptT Authorized <=< lift . E.selectExists . E.from
+    if | courseNewsParticipantsOnly
-    participant <- catchIfMExceptT (const $ unauthorizedI MsgUnauthorizedParticipant) (const True :: CryptoIDError -> Bool) $ decrypt cID
+         -> exceptT return (const mzero) . hoist lift $ isCourseParticipant tid ssh csh uid
-    -- participant is currently registered
+       | otherwise
-    $cachedHereBinary (participant, tid, ssh, csh) . authorizedIfExists $ \(course `E.InnerJoin` courseParticipant) -> do
+         -> return Authorized
-      E.on $ course E.^. CourseId E.==. courseParticipant E.^. CourseParticipantCourse
-      E.where_ $ courseParticipant E.^. CourseParticipantUser E.==. E.val participant
-           E.&&. course E.^. CourseTerm      E.==. E.val tid
-           E.&&. course E.^. CourseSchool    E.==. E.val ssh
-           E.&&. course E.^. CourseShorthand E.==. E.val csh
-    -- participant has at least one submission
-    $cachedHereBinary (participant, tid, ssh, csh) . authorizedIfExists $ \(course `E.InnerJoin` sheet `E.InnerJoin` submission `E.InnerJoin` submissionUser) -> do
-      E.on $ submission E.^. SubmissionId E.==. submissionUser E.^. SubmissionUserSubmission
-      E.on $ sheet  E.^. SheetId   E.==. submission E.^. SubmissionSheet
-      E.on $ course E.^. CourseId  E.==. sheet E.^. SheetCourse
-      E.where_ $ submissionUser E.^. SubmissionUserUser E.==. E.val participant
-           E.&&. course E.^. CourseTerm      E.==. E.val tid
-           E.&&. course E.^. CourseSchool    E.==. E.val ssh
-           E.&&. course E.^. CourseShorthand E.==. E.val csh
-    -- participant is member of a submissionGroup
-    $cachedHereBinary (participant, tid, ssh, csh) . authorizedIfExists $ \(course `E.InnerJoin` submissionGroup `E.InnerJoin` submissionGroupUser) -> do
-      E.on $ submissionGroup E.^. SubmissionGroupId  E.==. submissionGroupUser E.^. SubmissionGroupUserSubmissionGroup
-      E.on $ course E.^. CourseId  E.==. submissionGroup E.^. SubmissionGroupCourse
-      E.where_ $ submissionGroupUser E.^. SubmissionGroupUserUser E.==. E.val participant
-           E.&&. course E.^. CourseTerm      E.==. E.val tid
-           E.&&. course E.^. CourseSchool    E.==. E.val ssh
-           E.&&. course E.^. CourseShorthand E.==. E.val csh
-    -- participant is a sheet corrector
-    $cachedHereBinary (participant, tid, ssh, csh) . authorizedIfExists $ \(course `E.InnerJoin` sheet `E.InnerJoin` sheetCorrector) -> do
-      E.on $ sheet  E.^. SheetId   E.==. sheetCorrector E.^. SheetCorrectorSheet
-      E.on $ course E.^. CourseId  E.==. sheet E.^. SheetCourse
-      E.where_ $ sheetCorrector E.^. SheetCorrectorUser E.==. E.val participant
-           E.&&. course E.^. CourseTerm      E.==. E.val tid
-           E.&&. course E.^. CourseSchool    E.==. E.val ssh
-           E.&&. course E.^. CourseShorthand E.==. E.val csh
-    -- participant is a tutorial user
-    $cachedHereBinary (participant, tid, ssh, csh) . authorizedIfExists $ \(course `E.InnerJoin` tutorial `E.InnerJoin` tutorialUser) -> do
-      E.on $ tutorial  E.^. TutorialId   E.==. tutorialUser E.^. TutorialParticipantTutorial
-      E.on $ course E.^. CourseId  E.==. tutorial E.^. TutorialCourse
-      E.where_ $ tutorialUser E.^. TutorialParticipantUser E.==. E.val participant
-           E.&&. course E.^. CourseTerm      E.==. E.val tid
-           E.&&. course E.^. CourseSchool    E.==. E.val ssh
-           E.&&. course E.^. CourseShorthand E.==. E.val csh
-    -- participant is tutor for this course
-    $cachedHereBinary (participant, tid, ssh, csh) . authorizedIfExists $ \(course `E.InnerJoin` tutorial `E.InnerJoin` tutor) -> do
-      E.on $ tutorial  E.^. TutorialId   E.==. tutor E.^. TutorTutorial
-      E.on $ course E.^. CourseId E.==. tutorial E.^. TutorialCourse
-      E.where_ $ tutor E.^. TutorUser E.==. E.val participant
-           E.&&. course E.^. CourseTerm      E.==. E.val tid
-           E.&&. course E.^. CourseSchool    E.==. E.val ssh
-           E.&&. course E.^. CourseShorthand E.==. E.val csh
-    -- participant is lecturer for this course
-    $cachedHereBinary (participant, tid, ssh, csh) . authorizedIfExists $ \(course `E.InnerJoin` lecturer) -> do
-      E.on $ course E.^. CourseId E.==. lecturer E.^. LecturerCourse
-      E.where_ $ lecturer E.^. LecturerUser E.==. E.val participant
-           E.&&. course E.^. CourseTerm      E.==. E.val tid
-           E.&&. course E.^. CourseSchool    E.==. E.val ssh
-           E.&&. course E.^. CourseShorthand E.==. E.val csh
-    -- participant is applicant for this course
-    $cachedHereBinary (participant, tid, ssh, csh) . authorizedIfExists $ \((course `E.InnerJoin` courseApplication) `E.LeftOuterJoin` allocation) -> do
-      E.on $ allocation E.?. AllocationId E.==. courseApplication E.^. CourseApplicationAllocation
-      E.on $ course E.^. CourseId E.==. courseApplication E.^. CourseApplicationCourse
-      E.where_ $ courseApplication E.^. CourseApplicationUser E.==. E.val participant
-           E.&&. course E.^. CourseTerm      E.==. E.val tid
-           E.&&. course E.^. CourseSchool    E.==. E.val ssh
-           E.&&. course E.^. CourseShorthand E.==. E.val csh
-      E.where_ $ E.maybe E.true (E.maybe E.false $ \f -> f E.<=. E.val cTime) (allocation E.?. AllocationStaffAllocationFrom)
-           E.&&. E.maybe E.true (E.maybe E.true  $ \t -> t E.>=. E.val cTime) (allocation E.?. AllocationStaffAllocationTo)
 
+  CourseR tid ssh csh (CUserR cID) -> exceptT return return $ do
+    participant <- catchIfMExceptT (const $ unauthorizedI MsgUnauthorizedParticipant) (const True :: CryptoIDError -> Bool) $ decrypt cID
+    isCourseParticipant tid ssh csh participant
     unauthorizedI MsgUnauthorizedParticipant
+
   r -> $unsupportedAuthPredicate AuthParticipant r
+
+  where
+    isCourseParticipant tid ssh csh participant = do
+      cTime <- liftIO getCurrentTime
+      let
+        authorizedIfExists :: E.From a => (a -> E.SqlQuery b) -> ExceptT AuthResult DB ()
+        authorizedIfExists = flip whenExceptT Authorized <=< lift . E.selectExists . E.from
+      -- participant is currently registered
+      $cachedHereBinary (participant, tid, ssh, csh) . authorizedIfExists $ \(course `E.InnerJoin` courseParticipant) -> do
+        E.on $ course E.^. CourseId E.==. courseParticipant E.^. CourseParticipantCourse
+        E.where_ $ courseParticipant E.^. CourseParticipantUser E.==. E.val participant
+             E.&&. course E.^. CourseTerm      E.==. E.val tid
+             E.&&. course E.^. CourseSchool    E.==. E.val ssh
+             E.&&. course E.^. CourseShorthand E.==. E.val csh
+      -- participant has at least one submission
+      $cachedHereBinary (participant, tid, ssh, csh) . authorizedIfExists $ \(course `E.InnerJoin` sheet `E.InnerJoin` submission `E.InnerJoin` submissionUser) -> do
+        E.on $ submission E.^. SubmissionId E.==. submissionUser E.^. SubmissionUserSubmission
+        E.on $ sheet  E.^. SheetId   E.==. submission E.^. SubmissionSheet
+        E.on $ course E.^. CourseId  E.==. sheet E.^. SheetCourse
+        E.where_ $ submissionUser E.^. SubmissionUserUser E.==. E.val participant
+             E.&&. course E.^. CourseTerm      E.==. E.val tid
+             E.&&. course E.^. CourseSchool    E.==. E.val ssh
+             E.&&. course E.^. CourseShorthand E.==. E.val csh
+      -- participant is member of a submissionGroup
+      $cachedHereBinary (participant, tid, ssh, csh) . authorizedIfExists $ \(course `E.InnerJoin` submissionGroup `E.InnerJoin` submissionGroupUser) -> do
+        E.on $ submissionGroup E.^. SubmissionGroupId  E.==. submissionGroupUser E.^. SubmissionGroupUserSubmissionGroup
+        E.on $ course E.^. CourseId  E.==. submissionGroup E.^. SubmissionGroupCourse
+        E.where_ $ submissionGroupUser E.^. SubmissionGroupUserUser E.==. E.val participant
+             E.&&. course E.^. CourseTerm      E.==. E.val tid
+             E.&&. course E.^. CourseSchool    E.==. E.val ssh
+             E.&&. course E.^. CourseShorthand E.==. E.val csh
+      -- participant is a sheet corrector
+      $cachedHereBinary (participant, tid, ssh, csh) . authorizedIfExists $ \(course `E.InnerJoin` sheet `E.InnerJoin` sheetCorrector) -> do
+        E.on $ sheet  E.^. SheetId   E.==. sheetCorrector E.^. SheetCorrectorSheet
+        E.on $ course E.^. CourseId  E.==. sheet E.^. SheetCourse
+        E.where_ $ sheetCorrector E.^. SheetCorrectorUser E.==. E.val participant
+             E.&&. course E.^. CourseTerm      E.==. E.val tid
+             E.&&. course E.^. CourseSchool    E.==. E.val ssh
+             E.&&. course E.^. CourseShorthand E.==. E.val csh
+      -- participant is a tutorial user
+      $cachedHereBinary (participant, tid, ssh, csh) . authorizedIfExists $ \(course `E.InnerJoin` tutorial `E.InnerJoin` tutorialUser) -> do
+        E.on $ tutorial  E.^. TutorialId   E.==. tutorialUser E.^. TutorialParticipantTutorial
+        E.on $ course E.^. CourseId  E.==. tutorial E.^. TutorialCourse
+        E.where_ $ tutorialUser E.^. TutorialParticipantUser E.==. E.val participant
+             E.&&. course E.^. CourseTerm      E.==. E.val tid
+             E.&&. course E.^. CourseSchool    E.==. E.val ssh
+             E.&&. course E.^. CourseShorthand E.==. E.val csh
+      -- participant is tutor for this course
+      $cachedHereBinary (participant, tid, ssh, csh) . authorizedIfExists $ \(course `E.InnerJoin` tutorial `E.InnerJoin` tutor) -> do
+        E.on $ tutorial  E.^. TutorialId   E.==. tutor E.^. TutorTutorial
+        E.on $ course E.^. CourseId E.==. tutorial E.^. TutorialCourse
+        E.where_ $ tutor E.^. TutorUser E.==. E.val participant
+             E.&&. course E.^. CourseTerm      E.==. E.val tid
+             E.&&. course E.^. CourseSchool    E.==. E.val ssh
+             E.&&. course E.^. CourseShorthand E.==. E.val csh
+      -- participant is lecturer for this course
+      $cachedHereBinary (participant, tid, ssh, csh) . authorizedIfExists $ \(course `E.InnerJoin` lecturer) -> do
+        E.on $ course E.^. CourseId E.==. lecturer E.^. LecturerCourse
+        E.where_ $ lecturer E.^. LecturerUser E.==. E.val participant
+             E.&&. course E.^. CourseTerm      E.==. E.val tid
+             E.&&. course E.^. CourseSchool    E.==. E.val ssh
+             E.&&. course E.^. CourseShorthand E.==. E.val csh
+      -- participant is applicant for this course
+      $cachedHereBinary (participant, tid, ssh, csh) . authorizedIfExists $ \((course `E.InnerJoin` courseApplication) `E.LeftOuterJoin` allocation) -> do
+        E.on $ allocation E.?. AllocationId E.==. courseApplication E.^. CourseApplicationAllocation
+        E.on $ course E.^. CourseId E.==. courseApplication E.^. CourseApplicationCourse
+        E.where_ $ courseApplication E.^. CourseApplicationUser E.==. E.val participant
+             E.&&. course E.^. CourseTerm      E.==. E.val tid
+             E.&&. course E.^. CourseSchool    E.==. E.val ssh
+             E.&&. course E.^. CourseShorthand E.==. E.val csh
+        E.where_ $ E.maybe E.true (E.maybe E.false $ \f -> f E.<=. E.val cTime) (allocation E.?. AllocationStaffAllocationFrom)
+             E.&&. E.maybe E.true (E.maybe E.true  $ \t -> t E.>=. E.val cTime) (allocation E.?. AllocationStaffAllocationTo)
+
+      return ()
 tagAccessPredicate AuthCapacity = APDB $ \_ route _ -> case route of
   CTutorialR tid ssh csh tutn _ -> maybeT (unauthorizedI MsgTutorialNoCapacity) $ do
     cid <- $cachedHereBinary (tid, ssh, csh) . MaybeT . getKeyBy $ TermSchoolCourseShort tid ssh csh
@@ -1848,6 +1886,11 @@ instance YesodBreadcrumbs UniWorX where
   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)
 
+  breadcrumb (CourseR tid ssh csh CNewsNewR)    = return ("Neue Nachricht", Just $ CourseR tid ssh csh CShowR)
+  breadcrumb (CNewsR tid ssh csh _ CNShowR)     = return ("Kursnachricht" , Just $ CourseR tid ssh csh CShowR)
+  breadcrumb (CNewsR tid ssh csh cID CNEditR)   = return ("Bearbeiten"    , Just $ CNewsR tid ssh csh cID CNShowR)
+  breadcrumb (CNewsR tid ssh csh cID CNDeleteR) = return ("Löschen"       , Just $ CNewsR tid ssh csh cID CNShowR)
+
   breadcrumb (CourseR tid ssh csh CExamListR) = return ("Prüfungen", Just $ CourseR tid ssh csh CShowR)
   breadcrumb (CourseR tid ssh csh CExamNewR) = return ("Anlegen", Just $ CourseR tid ssh csh CExamListR)
 
@@ -3135,12 +3178,18 @@ routeNormalizers :: [Route UniWorX -> WriterT Any DB (Route UniWorX)]
 routeNormalizers =
   [ normalizeRender
   , ncSchool
+  , ncAllocation
   , ncCourse
   , ncSheet
+  , ncMaterial
+  , ncTutorial
+  , ncExam
   , verifySubmission
   , verifyCourseApplication
+  , verifyCourseNews
   ]
   where
+    normalizeRender :: Route UniWorX -> WriterT Any DB (Route UniWorX)
     normalizeRender route = route <$ do
       YesodRequest{..} <- liftHandler getRequest
       let original = (W.pathInfo reqWaiRequest, reqGetParams)
@@ -3151,37 +3200,64 @@ routeNormalizers =
         | otherwise -> do
             $logDebugS "normalizeRender" [st|Redirecting because #{tshow rendered} does not match #{tshow original}|]
             tell $ Any True
+
+    maybeOrig :: (Route UniWorX -> MaybeT (WriterT Any DB) (Route UniWorX))
+              -> Route UniWorX -> WriterT Any DB (Route UniWorX)
     maybeOrig f route = maybeT (return route) $ f route
-    hasChanged a b
+
+    caseChanged :: (Eq a, Show a) => CI a -> CI a -> MaybeT (WriterT Any DB) ()
+    caseChanged a b
       | ((/=) `on` original) a b = do
           $logDebugS "routeNormalizers" [st|#{tshow a} /= #{tshow b}|]
           tell $ Any True
       | otherwise                   = return ()
-    ncSchool = maybeOrig $ \route -> do
+
-      TermSchoolCourseListR tid ssh <- return route
+    ncSchool = maybeOrig . typesUsing @RouteChildren @SchoolId $ \ssh -> $cachedHereBinary ssh $ do
       let schoolShort :: SchoolShorthand
           schoolShort = unSchoolKey ssh
       Entity ssh' _  <- MaybeT . lift . getBy $ UniqueSchoolShorthand schoolShort
-      (hasChanged `on` unSchoolKey)ssh ssh'
+      (caseChanged `on` unSchoolKey) ssh ssh'
-      return $ TermSchoolCourseListR tid ssh'
+      return ssh'
+    ncAllocation = maybeOrig $ \route -> do
+      AllocationR tid ssh ash _ <- return route
+      Entity _ Allocation{..} <- MaybeT . $cachedHereBinary (tid, ssh, ash) . lift . getBy $ TermSchoolAllocationShort tid ssh ash
+      caseChanged ash allocationShorthand
+      return $ route & typesUsing @RouteChildren @AllocationShorthand . filtered (== ash) .~ allocationShorthand
     ncCourse = maybeOrig $ \route -> do
-      CourseR tid ssh csh subRoute <- return route
+      CourseR tid ssh csh _ <- return route
-      Entity _ Course{..} <- MaybeT . lift . getBy $ TermSchoolCourseShort tid ssh csh
+      Entity _ Course{..} <- MaybeT . $cachedHereBinary (tid, ssh, csh) . lift . getBy $ TermSchoolCourseShort tid ssh csh
-      hasChanged csh courseShorthand
+      caseChanged csh courseShorthand
-      (hasChanged `on` unSchoolKey) ssh courseSchool
+      return $ route & typesUsing @RouteChildren @CourseShorthand . filtered (== csh) .~ courseShorthand
-      return $ CourseR tid courseSchool courseShorthand subRoute
     ncSheet = maybeOrig $ \route -> do
-      CSheetR tid ssh csh shn subRoute <- return route
+      CSheetR tid ssh csh shn _ <- return route
-      Entity cid _ <- MaybeT . lift . getBy $ TermSchoolCourseShort tid ssh csh
+      Entity cid Course{..} <- MaybeT . $cachedHereBinary (tid, ssh, csh) . lift . getBy $ TermSchoolCourseShort tid ssh csh
-      Entity _ Sheet{..} <- MaybeT . lift . getBy $ CourseSheet cid shn
+      Entity _ Sheet{..} <- MaybeT . $cachedHereBinary (cid, shn) . lift . getBy $ CourseSheet cid shn
-      hasChanged shn sheetName
+      caseChanged shn sheetName
-      return $ CSheetR tid ssh csh sheetName subRoute
+      return $ route & typesUsing @RouteChildren @SheetName . filtered (== shn) .~ sheetName
+    ncMaterial = maybeOrig $ \route -> do
+      CMaterialR tid ssh csh mnm _ <- return route
+      Entity cid Course{..} <- MaybeT  . $cachedHereBinary (tid, ssh, csh) . lift . getBy $ TermSchoolCourseShort tid ssh csh
+      Entity _ Material{..} <- MaybeT . $cachedHereBinary (cid, mnm) . lift . getBy $ UniqueMaterial cid mnm
+      caseChanged mnm materialName
+      return $ route & typesUsing @RouteChildren @MaterialName . filtered (== mnm) .~ materialName
+    ncTutorial = maybeOrig $ \route -> do
+      CTutorialR tid ssh csh tutn _ <- return route
+      Entity cid Course{..} <- MaybeT  . $cachedHereBinary (tid, ssh, csh) . lift . getBy $ TermSchoolCourseShort tid ssh csh
+      Entity _ Tutorial{..} <- MaybeT . $cachedHereBinary (cid, tutn) . lift . getBy $ UniqueTutorial cid tutn
+      caseChanged tutn tutorialName
+      return $ route & typesUsing @RouteChildren @TutorialName . filtered (== tutn) .~ tutorialName
+    ncExam = maybeOrig $ \route -> do
+      CExamR tid ssh csh examn _ <- return route
+      Entity cid Course{..} <- MaybeT  . $cachedHereBinary (tid, ssh, csh) . lift . getBy $ TermSchoolCourseShort tid ssh csh
+      Entity _ Exam{..} <- MaybeT . $cachedHereBinary (cid, examn) . lift . getBy $ UniqueExam cid examn
+      caseChanged examn examName
+      return $ route & typesUsing @RouteChildren @ExamName . filtered (== examn) .~ examName
     verifySubmission = maybeOrig $ \route -> do
       CSubmissionR _tid _ssh _csh _shn cID sr <- return route
-      sId <- decrypt cID
+      sId <- $cachedHereBinary cID $ decrypt cID
-      Submission{submissionSheet}   <- lift . lift $ get404 sId
+      Submission{submissionSheet} <- MaybeT . $cachedHereBinary cID . lift $ get sId
-      Sheet{sheetCourse, sheetName} <- lift . lift $ get404 submissionSheet
+      Sheet{sheetCourse, sheetName} <- MaybeT . $cachedHereBinary submissionSheet . lift $ get submissionSheet
-      Course{courseTerm, courseSchool, courseShorthand} <- lift . lift $ get404 sheetCourse
+      Course{courseTerm, courseSchool, courseShorthand} <- MaybeT . $cachedHereBinary sheetCourse . lift $ get sheetCourse
       let newRoute = CSubmissionR courseTerm courseSchool courseShorthand sheetName cID sr
       tell . Any $ route /= newRoute
       return newRoute
@@ -3193,6 +3269,14 @@ routeNormalizers =
       let newRoute = CApplicationR courseTerm courseSchool courseShorthand cID sr
       tell . Any $ route /= newRoute
       return newRoute
+    verifyCourseNews = maybeOrig $ \route -> do
+      CNewsR _tid _ssh _csh cID sr <- return route
+      aId <- decrypt cID
+      CourseNews{courseNewsCourse} <- lift . lift $ get404 aId
+      Course{courseTerm, courseSchool, courseShorthand} <- lift . lift $ get404 courseNewsCourse
+      let newRoute = CNewsR courseTerm courseSchool courseShorthand cID sr
+      tell . Any $ route /= newRoute
+      return newRoute
 
 
 -- How to run database actions.
@@ -3202,7 +3286,9 @@ instance YesodPersist UniWorX where
       $logDebugS "YesodPersist" "runDB"
       runSqlPool action =<< appConnPool <$> getYesod
 instance YesodPersistRunner UniWorX where
-    getDBRunner = defaultGetDBRunner appConnPool
+    getDBRunner = do
+      (DBRunner{..}, cleanup) <- defaultGetDBRunner appConnPool
+      return . (, cleanup) $ DBRunner (\act -> $logDebugS "YesodPersist" "runDBRunner" >> runDBRunner act)
 
 data CampusUserConversionException
   = CampusUserInvalidEmail

src/Handler/Course.hs

@@ -17,6 +17,7 @@ import Handler.Course.User as Handler.Course
 import Handler.Course.Users as Handler.Course
 import Handler.Course.Application as Handler.Course
 import Handler.ExamOffice.Course as Handler.Course
+import Handler.Course.News as Handler.Course
 
 
 getCHiWisR :: TermId -> SchoolId -> CourseShorthand -> Handler Html

src/Handler/Course/News.hs

@@ -0,0 +1,9 @@
+module Handler.Course.News
+  ( module Handler.Course.News
+  ) where
+
+import Handler.Course.News.New as Handler.Course.News
+import Handler.Course.News.Edit as Handler.Course.News
+import Handler.Course.News.Download as Handler.Course.News
+import Handler.Course.News.Show as Handler.Course.News
+import Handler.Course.News.Delete as Handler.Course.News

src/Handler/Course/News/Delete.hs

@@ -0,0 +1,44 @@
+module Handler.Course.News.Delete
+  ( getCNDeleteR, postCNDeleteR
+  ) where
+
+import Import
+import Handler.Utils.Delete
+
+import qualified Data.Set as Set
+
+
+getCNDeleteR, postCNDeleteR :: TermId -> SchoolId -> CourseShorthand -> CryptoUUIDCourseNews -> Handler Html
+getCNDeleteR = postCNDeleteR
+postCNDeleteR tid ssh csh cID = do
+  nId <- decrypt cID
+  
+  let
+    drRecords :: Set (Key CourseNews)
+    drRecords = Set.singleton nId
+
+    drGetInfo = return
+    drUnjoin = id
+
+    drRenderRecord :: Entity CourseNews -> DB Widget
+    drRenderRecord (Entity _ CourseNews{..})
+      = return . fromMaybe (toWidget courseNewsContent) $ asum
+        [ toWidget <$> courseNewsTitle
+        , toWidget <$> courseNewsSummary
+        ]
+  
+    drRecordConfirmString :: Entity CourseNews -> DB Text
+    drRecordConfirmString _ = return ""
+  
+    drCaption, drSuccessMessage :: SomeMessage UniWorX
+    drCaption = SomeMessage MsgCourseNewsDeleteQuestion
+    drSuccessMessage = SomeMessage MsgCourseNewsDeleted
+  
+    drAbort, drSuccess :: SomeRoute UniWorX
+    drAbort = SomeRoute $ CourseR tid ssh csh CShowR :#: [st|news-#{toPathPiece cID}|]
+    drSuccess = SomeRoute $ CourseR tid ssh csh CShowR
+  
+    drDelete :: forall a. CourseNewsId -> DB a -> DB a
+    drDelete _ = id
+  
+  deleteR DeleteRoute{..}

src/Handler/Course/News/Download.hs

@@ -0,0 +1,41 @@
+module Handler.Course.News.Download
+  ( getCNArchiveR
+  , getCNFileR
+  ) where
+
+import Import
+import Handler.Utils
+
+import qualified Database.Esqueleto as E
+
+import qualified Data.Conduit.List as C
+
+
+getCNArchiveR :: TermId -> SchoolId -> CourseShorthand -> CryptoUUIDCourseNews -> Handler TypedContent
+getCNArchiveR tid ssh csh cID = do
+  nId <- decrypt cID
+  CourseNews{..} <- runDB $ get404 nId
+
+  archiveName <- fmap (flip addExtension (unpack extensionZip) . unpack). ap getMessageRender . pure $ MsgCourseNewsArchiveName tid ssh csh (fromMaybe (toPathPiece courseNewsLastEdit) courseNewsTitle)
+
+  let getFilesQuery = (.| C.map entityVal) . E.selectSource . E.from $
+        \(newsFile `E.InnerJoin` file) -> do
+          E.on $ file E.^. FileId E.==. newsFile E.^. CourseNewsFileFile
+          E.where_ $ newsFile E.^. CourseNewsFileNews E.==. E.val nId
+          return file
+
+  serveSomeFiles archiveName getFilesQuery
+
+  
+getCNFileR :: TermId -> SchoolId -> CourseShorthand -> CryptoUUIDCourseNews -> FilePath -> Handler TypedContent
+getCNFileR _ _ _ cID title = do
+  nId <- decrypt cID
+
+  let
+    fileQuery = E.selectSource . E.from $ \(newsFile `E.InnerJoin` file) -> do
+        E.on $ newsFile E.^. CourseNewsFileFile E.==. file E.^. FileId
+        E.where_ $ newsFile E.^. CourseNewsFileNews E.==. E.val nId
+             E.&&. file     E.^. FileTitle          E.==. E.val title
+        return file
+
+  serveOneFile $ fileQuery .| C.map entityVal

src/Handler/Course/News/Edit.hs

@@ -0,0 +1,54 @@
+module Handler.Course.News.Edit
+  ( getCNEditR, postCNEditR
+  ) where
+
+import Import
+import Handler.Utils
+
+import Handler.Course.News.Form
+
+import qualified Data.Set as Set
+
+import qualified Data.Conduit.List as C
+
+
+getCNEditR, postCNEditR :: TermId -> SchoolId -> CourseShorthand -> CryptoUUIDCourseNews -> Handler Html
+getCNEditR = postCNEditR
+postCNEditR tid ssh csh cID = do
+  nId <- decrypt cID
+  (courseNews@CourseNews{..}, fids) <- runDB $ do
+    courseNews <- get404 nId
+    cnfs <- selectList [CourseNewsFileNews ==. nId] []
+    return ( courseNews
+           , setOf (folded . _entityVal . _courseNewsFileFile) cnfs
+           )
+
+  ((newsRes, newsWgt'), newsEnctype) <- runFormPost . courseNewsForm . Just $ courseNewsToForm courseNews fids
+
+  formResult newsRes $ \CourseNewsForm{..} -> do
+    now <- liftIO getCurrentTime
+    runDB $ do
+      replace nId CourseNews
+        { courseNewsCourse
+        , courseNewsVisibleFrom      = cnfVisibleFrom
+        , courseNewsParticipantsOnly = cnfParticipantsOnly
+        , courseNewsTitle            = cnfTitle
+        , courseNewsContent          = cnfContent
+        , courseNewsSummary          = cnfSummary
+        , courseNewsLastEdit         = now
+        }
+      let
+        insertFile (Left  fId) = fId <$ upsertBy (UniqueCourseNewsFile nId fId) (CourseNewsFile nId fId) []
+        insertFile (Right f  ) = insert f >>= \fId -> fId <$ insert_ (CourseNewsFile nId fId)
+      newFids <- runConduit $ transPipe lift (fromMaybe (return ()) cnfFiles) .| C.mapM insertFile .| C.foldMap Set.singleton
+      deleteWhere [ CourseNewsFileNews ==. nId, CourseNewsFileFile /<-. Set.toList newFids ]
+    addMessageI Success MsgCourseNewsEdited
+    redirect $ CourseR tid ssh csh CShowR :#: [st|news-#{toPathPiece cID}|]
+
+  siteLayoutMsg MsgMenuCourseNewsEdit $ do
+    setTitleI MsgMenuCourseNewsEdit
+
+    wrapForm newsWgt' def
+      { formAction = Just . SomeRoute $ CNewsR tid ssh csh cID CNEditR
+      , formEncoding = newsEnctype
+      }

src/Handler/Course/News/Form.hs

@@ -0,0 +1,71 @@
+module Handler.Course.News.Form
+  ( CourseNewsForm(..)
+  , courseNewsForm
+  , courseNewsToForm
+  ) where
+
+import Import
+import Handler.Utils
+
+import Text.Blaze.Renderer.Text (renderMarkup)
+
+import qualified Data.Conduit.List as C
+
+import qualified Data.Set as Set
+
+
+data CourseNewsForm = CourseNewsForm
+  { cnfTitle            :: Maybe Text
+  , cnfSummary          :: Maybe Html
+  , cnfContent          :: Html
+  , cnfParticipantsOnly :: Bool
+  , cnfVisibleFrom      :: Maybe UTCTime
+  , cnfFiles            :: Maybe (ConduitT () (Either FileId File) Handler ())
+  }
+
+courseNewsForm :: Maybe CourseNewsForm -> Form CourseNewsForm
+courseNewsForm template = identifyForm FIDCourseNews . renderWForm FormStandard $ do
+  now <- liftIO getCurrentTime
+
+  let oldFileIds = maybe (return mempty) (\s -> runConduit $ s .| C.foldMap (either opoint $ const mempty)) $ template >>= cnfFiles
+      cTime = ceilingQuarterHour now
+      visibleFromTip
+        | Just vFrom <- template >>= cnfVisibleFrom
+        , vFrom <= now
+        = MsgCourseNewsVisibleFromEditWarning
+        | otherwise
+        = MsgCourseNewsVisibleFromTip
+
+  cnfTitle' <- wopt
+    (textField & cfStrip & guardField (not . null))
+    (fslI MsgCourseNewsTitle)
+    (cnfTitle <$> template)
+  cnfSummary' <- wopt
+    (htmlField & guardField (not . null . renderMarkup))
+    (fslI MsgCourseNewsSummary & setTooltip MsgCourseNewsSummaryTip)
+    (cnfSummary <$> template)
+  cnfContent' <- wreq
+    (htmlField & guardField (not . null . renderMarkup))
+    (fslI MsgCourseNewsContent)
+    (cnfContent <$> template)
+  cnfParticipantsOnly' <- wpopt checkBoxField (fslI MsgCourseNewsParticipantsOnly) (cnfParticipantsOnly <$> template)
+  cnfVisibleFrom' <- wopt utcTimeField (fslI MsgCourseNewsVisibleFrom & setTooltip visibleFromTip) (cnfVisibleFrom <$> template <|> Just (Just cTime))
+  cnfFiles' <- wopt (multiFileField oldFileIds) (fslI MsgCourseNewsFiles) (cnfFiles <$> template)
+
+  return $ CourseNewsForm
+    <$> cnfTitle'
+    <*> cnfSummary'
+    <*> cnfContent'
+    <*> cnfParticipantsOnly'
+    <*> cnfVisibleFrom'
+    <*> cnfFiles'
+
+courseNewsToForm :: CourseNews -> Set FileId -> CourseNewsForm
+courseNewsToForm CourseNews{..} fs = CourseNewsForm
+  { cnfTitle = courseNewsTitle
+  , cnfSummary = courseNewsSummary
+  , cnfContent = courseNewsContent
+  , cnfParticipantsOnly = courseNewsParticipantsOnly
+  , cnfVisibleFrom = courseNewsVisibleFrom
+  , cnfFiles = guardOn (not $ Set.null fs) $ C.sourceList (Left <$> Set.toList fs)
+  }

src/Handler/Course/News/New.hs

@@ -0,0 +1,47 @@
+module Handler.Course.News.New
+  ( getCNewsNewR, postCNewsNewR
+  ) where
+
+import Import
+import Handler.Utils
+
+import Handler.Course.News.Form
+
+import qualified Data.Conduit.List as C
+
+
+getCNewsNewR, postCNewsNewR :: TermId -> SchoolId -> CourseShorthand -> Handler Html
+getCNewsNewR = postCNewsNewR
+postCNewsNewR tid ssh csh = do
+  cid <- runDB . getKeyBy404 $ TermSchoolCourseShort tid ssh csh
+
+  ((newsRes, newsWgt'), newsEnctype) <- runFormPost $ courseNewsForm Nothing
+
+  formResult newsRes $ \CourseNewsForm{..} -> do
+    now <- liftIO getCurrentTime
+    cID <- runDB $ do
+      nId <- insert CourseNews
+        { courseNewsCourse           = cid
+        , courseNewsVisibleFrom      = cnfVisibleFrom
+        , courseNewsParticipantsOnly = cnfParticipantsOnly
+        , courseNewsTitle            = cnfTitle
+        , courseNewsContent          = cnfContent
+        , courseNewsSummary          = cnfSummary
+        , courseNewsLastEdit         = now
+        }
+      let
+        insertFile (Left  fId) = insert_ $ CourseNewsFile nId fId
+        insertFile (Right f  ) = insert_ . CourseNewsFile nId =<< insert f
+      forM_ cnfFiles $ \fSource ->
+        runConduit $ transPipe lift fSource .| C.mapM_ insertFile
+      encrypt nId :: DB CryptoUUIDCourseNews
+    addMessageI Success MsgCourseNewsCreated
+    redirect $ CourseR tid ssh csh CShowR :#: [st|news-#{toPathPiece cID}|]
+
+  siteLayoutMsg MsgMenuCourseNewsNew $ do
+    setTitleI MsgMenuCourseNewsNew
+
+    wrapForm newsWgt' def
+      { formAction = Just . SomeRoute $ CourseR tid ssh csh CNewsNewR
+      , formEncoding = newsEnctype
+      }

src/Handler/Course/News/Show.hs

@@ -0,0 +1,17 @@
+module Handler.Course.News.Show
+  ( getCNShowR
+  ) where
+
+import Import
+import Handler.Utils
+
+
+getCNShowR :: TermId -> SchoolId -> CourseShorthand -> CryptoUUIDCourseNews -> Handler Html
+getCNShowR tid ssh csh cID = do
+  nId <- decrypt cID
+  CourseNews{..} <- runDB $ get404 nId
+
+  siteLayout' (toWidget <$> courseNewsTitle) $ do
+    setTitleI . prependCourseTitle tid ssh csh $ maybe (SomeMessage MsgCourseNews) SomeMessage courseNewsTitle
+
+    $(widgetFile "course-news")

src/Handler/Course/Show.hs

@@ -18,7 +18,7 @@ import qualified Database.Esqueleto as E
 
 import Handler.Course.Register
 
-import System.FilePath (addExtension)
+import System.FilePath (addExtension, pathSeparator)
 
 import qualified Data.Conduit.List as C
 
@@ -26,7 +26,7 @@ import qualified Data.Conduit.List as C
 getCShowR :: TermId -> SchoolId -> CourseShorthand -> Handler Html
 getCShowR tid ssh csh = do
   mbAid <- maybeAuthId
-  (cid,course,schoolName,participants,registration,lecturers,assistants,correctors,tutors,mAllocation,hasApplicationTemplate,mApplication) <- runDB . maybeT notFound $ do
+  (cid,course,schoolName,participants,registration,lecturers,assistants,correctors,tutors,mAllocation,hasApplicationTemplate,mApplication,news) <- runDB . maybeT notFound $ do
     [(E.Entity cid course, E.Value schoolName, E.Value participants, fmap entityVal -> registration)]
        <- lift . E.select . E.from $
          \((school `E.InnerJoin` course) `E.LeftOuterJoin` participant) -> do
@@ -71,12 +71,25 @@ getCShowR tid ssh csh = do
     hasApplicationTemplate <- lift . E.selectExists . E.from $ \courseAppInstructionFile ->
       E.where_ $ courseAppInstructionFile E.^. CourseAppInstructionFileCourse E.==. E.val cid
     mApplication <- lift . fmap (listToMaybe =<<) . for mbAid $ \uid -> selectList [CourseApplicationCourse ==. cid, CourseApplicationUser ==. uid, CourseApplicationAllocation ==. Nothing] []
-    return (cid,course,schoolName,participants,registration,lecturers,assistants,correctors,tutors,mAllocation,hasApplicationTemplate,mApplication)
+    news' <- lift $ selectList [ CourseNewsCourse ==. cid ] [ Desc CourseNewsVisibleFrom, Desc CourseNewsTitle, Desc CourseNewsSummary, Desc CourseNewsContent ]
+    cTime <- NTop . Just <$> liftIO getCurrentTime
+    news <- forMaybeM news' $ \(Entity nId n@CourseNews{..}) -> do
+      cID <- encrypt nId :: MaybeT (MaybeT DB) CryptoUUIDCourseNews
+      guardM . hasReadAccessTo $ CNewsR tid ssh csh cID CNShowR
+      let visible = cTime >= NTop courseNewsVisibleFrom
+      files' <- lift . lift . E.select . E.from $ \(newsFile `E.InnerJoin` file) -> do
+        E.on $ file E.^. FileId E.==. newsFile E.^. CourseNewsFileFile
+        E.where_ $ newsFile E.^. CourseNewsFileNews E.==. E.val nId
+        return (E.isNothing $ file E.^. FileContent, file E.^. FileTitle)
+      let files = files'
+            & over (mapped . _1) E.unValue
+            & over (mapped . _2) E.unValue
+      lastEditText <- formatTime SelFormatDateTime $ maybe id max (guardOn visible =<< courseNewsVisibleFrom) courseNewsLastEdit
+      return (cID, n, visible, files, lastEditText)
+    return (cid,course,schoolName,participants,registration,lecturers,assistants,correctors,tutors,mAllocation,hasApplicationTemplate,mApplication,news)
 
-  mRegFrom <- traverse (formatTime SelFormatDateTime) $ courseRegisterFrom    course
-  mRegTo   <- traverse (formatTime SelFormatDateTime) $ courseRegisterTo      course
   mDereg   <- traverse (formatTime SelFormatDateTime) $ courseDeregisterUntil course
-  mRegAt   <- traverse (formatTime SelFormatDateTime) $ courseParticipantRegistration <$> registration
+
   cID <- encrypt cid :: Handler CryptoUUIDCourse
   mAllocation' <- for mAllocation $ \Allocation{..} -> (,)
     <$> pure allocationName
@@ -236,6 +249,14 @@ getCShowR tid ssh csh = do
       & defaultSorting [SortAscBy "time"]
   (Any hasExams, examTable) <- runDB $ dbTable examDBTableValidator examDBTable
 
+  let visibleNews = any (view _3) news
+      showNewsFiles fs = and
+        [ not $ null fs
+        , length fs <= 3
+        , all (not . elem pathSeparator . view _2) fs
+        ]
+  mayCreateNews <- hasWriteAccessTo $ CourseR tid ssh csh CNewsNewR
+
   siteLayout (toWgt $ courseName course) $ do
     setTitleI $ prependCourseTitle tid ssh csh (""::Text)
     $(widgetFile "course")

src/Handler/Material.hs

@@ -61,7 +61,7 @@ makeMaterialForm cid template = identifyForm FIDmaterial $ \html -> do
 
   flip (renderAForm FormStandard) html $ MaterialForm
       <$> areq (textField & cfStrip & cfCI) (fslI MsgMaterialName)         (mfName        <$> template)
-      <*> aopt (textField & cfStrip & cfCI & addDatalist typeOptions)
+      <*> aopt (textField & cfStrip & guardField (not . null) & cfCI & addDatalist typeOptions)
                               (fslpI MsgMaterialType $ mr MsgMaterialTypePlaceholder)
                                                              (mfType        <$> template)
       <*> aopt htmlField      (fslpI MsgMaterialDescription "Html")

src/Handler/Utils/Delete.hs

@@ -53,14 +53,17 @@ confirmForm confirmString = flip traverseAForm aform $ \(inpConfirmStr, BtnDelet
   where
     aform = (,)
         <$> areq confirmField (fslI MsgDeleteConfirmation) Nothing
-        <*> disambiguateButtons (combinedButtonFieldF "")
+        <*> pure BtnDelete
     confirmField
       | multiple  = convertField unTextarea Textarea textareaField
       | otherwise = textField
     multiple = length (filter (not . Text.null . Text.strip) $ Text.lines confirmString) > 1
 
+confirmFormReduced :: Monad m => AForm m Bool
+confirmFormReduced = pure True
+
 confirmForm' :: PersistEntity record => Set (Key record) -> Text -> Form Bool
-confirmForm' drRecords confirmString = addDeleteTargets . identifyForm FIDDelete . renderAForm FormStandard $ confirmForm confirmString
+confirmForm' drRecords confirmString = addDeleteTargets . identifyForm FIDDelete . renderAForm FormStandard . maybe confirmFormReduced confirmForm $ assertM' (not . Text.null . Text.strip) confirmString
   where
     addDeleteTargets :: Form a -> Form a
     addDeleteTargets form csrf = do
@@ -99,10 +102,10 @@ getDeleteR DeleteRoute{..} = do
   (deleteFormWdgt, deleteFormEnctype) <- generateFormPost $ confirmForm' drRecords confirmString
 
   targetRoute <- fromMaybe (error "getDeleteR called from 404-handler") <$> getCurrentRoute
-  let deleteForm = wrapForm deleteFormWdgt def
+  let deleteForm = wrapForm' BtnDelete deleteFormWdgt def
         { formAction = Just $ SomeRoute targetRoute
         , formEncoding = deleteFormEnctype
-        , formSubmit = FormNoSubmit
+        , formSubmit = FormSubmit
         }
 
   sendResponse =<<

src/Handler/Utils/Form.hs

@@ -746,10 +746,11 @@ multiFileField permittedFiles' = Field{..}
                 | Right sentVals' <- sentVals = fuiId' `elem` sentVals'
                 | otherwise = True
           return FileUploadInfo{..}
-      fileInfos <- mapM toFUI <=< handlerToWidget . runDB . E.select . E.from $ \file -> do
+      fileInfos' <- mapM toFUI <=< handlerToWidget . runDB . E.select . E.from $ \file -> do
           E.where_ $ file E.^. FileId `E.in_` E.valList (setToList pVals)
           E.orderBy [E.asc $ file E.^. FileTitle]
           return (file E.^. FileId, file E.^. FileTitle)
+      let fileInfos = sortOn fuiTitle fileInfos'
       $(widgetFile "widgets/multiFileField")
     unpackZips :: Text
     unpackZips = "unpack-zip"

src/Handler/Utils/Table/Pagination.hs

@@ -961,7 +961,7 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db
         Map.foldrWithKey (\key args expr -> E.where_ (filterColumn (Map.findWithDefault (error $ "Invalid filter key: " <> show key) key dbtFilter) args t) >> expr) (return ()) psFilter
     return (E.unsafeSqlValue "count(*) OVER ()" :: E.SqlExpr (E.Value Int64), dbtRowKey t, res)
 
-  let mapMaybeM f = fmap catMaybes . mapM (\(k, v) -> runMaybeT $ (,) <$> pure k <*> f v)
+  let mapMaybeM' f = mapMaybeM $ \(k, v) -> (,) <$> pure k <*> f v
       firstRow :: Int64
       firstRow
         | PagesizeLimit l <- psLimit
@@ -974,7 +974,7 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db
         | otherwise
         = id
 
-  (currentKeys, rows) <- fmap unzip . mapMaybeM dbtProj . map (\(dbrIndex, (E.Value dbrCount, dbrKey, dbrOutput)) -> (dbrKey, DBRow{..})) . zip [firstRow..] $ reproduceSorting rows'
+  (currentKeys, rows) <- fmap unzip . mapMaybeM' dbtProj . map (\(dbrIndex, (E.Value dbrCount, dbrKey, dbrOutput)) -> (dbrKey, DBRow{..})) . zip [firstRow..] $ reproduceSorting rows'
 
 
   formResult csvMode $ \case

src/Utils.hs

@@ -51,7 +51,9 @@ import Control.Arrow as Utils ((>>>))
 import Control.Monad.Trans.Except (ExceptT(..), throwE, runExceptT)
 import Control.Monad.Except (MonadError(..))
 import Control.Monad.Trans.Maybe as Utils (MaybeT(..))
+import Control.Monad.Trans.Writer.Lazy (execWriterT, tell)
 import Control.Monad.Catch
+import Control.Monad.Morph (hoist)
 
 import Language.Haskell.TH
 import Language.Haskell.TH.Instances ()
@@ -529,6 +531,20 @@ maybeThrow exc = maybe (throwM exc) return
 maybeThrowM :: (MonadThrow m, Exception e) => m e -> Maybe a -> m a
 maybeThrowM excM = maybe (throwM =<< excM) return
 
+mapMaybeM :: ( Monad m
+             , MonoFoldable (f a)
+             , MonoPointed (f b)
+             , Monoid (f b)
+             ) => (Element (f a) -> MaybeT m (Element (f b))) -> f a -> m (f b)
+mapMaybeM f = execWriterT . mapM_ (void . runMaybeT . (lift . tell . opoint <=< hoist lift . f))
+
+forMaybeM :: ( Monad m
+             , MonoFoldable (f a)
+             , MonoPointed (f b)
+             , Monoid (f b)
+             ) => f a -> (Element (f a) -> MaybeT m (Element (f b))) -> m (f b)
+forMaybeM = flip mapMaybeM
+
 ------------
 -- Either --
 ------------

src/Utils/Form.hs

@@ -196,6 +196,7 @@ data FormIdentifier
   | FIDcourseRegister
   | FIDsheet
   | FIDmaterial
+  | FIDCourseNews
   | FIDsubmission
   | FIDsettings
   | FIDcorrectors

src/Utils/Lens.hs

@@ -19,10 +19,14 @@ import Utils.Lens.TH as Utils.Lens
 import Data.Set.Lens as Utils.Lens
 import Data.Map.Lens as Utils.Lens
 
+import Data.Generics.Product.Types as Utils.Lens
+
 import Yesod.Core.Types (HandlerContents(..), ErrorResponse(..))
 
 import qualified Database.Esqueleto as E (Value(..),InnerJoin(..))
 
+import qualified Data.CaseInsensitive as CI
+
 
 _PathPiece :: PathPiece v => Prism' Text v
 _PathPiece = prism' toPathPiece fromPathPiece
@@ -48,6 +52,9 @@ _SchoolId = iso unSchoolKey SchoolKey
 _Maybe :: Iso' (Maybe ()) Bool
 _Maybe = iso (is _Just) (bool Nothing (Just ()))
 
+_CI :: FoldCase s => Iso' (CI s) s
+_CI = iso CI.original CI.mk
+
 
 -----------------------------------
 -- Lens Definitions for our Types
@@ -197,6 +204,8 @@ makeLenses_ ''SchoolLdap
 makeLenses_ ''UserFunction
 
 makeLenses_ ''CourseUserExamOfficeOptOut
+
+makeLenses_ ''CourseNewsFile
   
 
 -- makeClassy_ ''Load

stack.yaml

@@ -58,5 +58,7 @@ extra-deps:
 
   - process-1.6.5.1
 
+  - generic-lens-1.2.0.0
+
 resolver: lts-13.21
 allow-newer: true

templates/course-news.hamlet

@@ -0,0 +1,12 @@
+$newline never
+$maybe summary <- courseNewsSummary
+  <section>
+    <dl .deflist>
+      <dt .deflist__dt>
+        _{MsgCourseNewsSummary}
+      <dd .deflist__dd>
+        #{summary}
+  <section>
+    #{courseNewsContent}
+$nothing
+  #{courseNewsContent}

templates/course.hamlet

@@ -1,16 +1,75 @@
 $newline never
 <dl .deflist>
-  <dt .deflist__dt>Fakultät/Institut
+  $if not (null news) || not visibleNews
-  <dd .deflist__dd>
+    <dt .deflist__dt>
-    <div>
+      _{MsgCourseNews}
-      #{schoolName}
+      $if not visibleNews
-
+        \ #{iconInvisible}
+    <dd .deflist__dd>
+      $if not (null news)
+        <ul .course-news .list--iconless>
+          $forall (cID, CourseNews{courseNewsTitle, courseNewsSummary, courseNewsContent}, isVisible, files, lastEditText) <- news
+            <li .course-news-item ##{"news-" <> toPathPiece cID}>
+              $case (courseNewsTitle, courseNewsSummary)
+$#                 $of (Just title, Just summary)
+$#                   <div .div-h3 .course-news-item__title>
+$#                     ^{modal (toWidget title) (Left (SomeRoute (CNewsR tid ssh csh cID CNShowR)))}
+$#                     $if not isVisible
+$#                       \ #{iconInvisible}
+$#                   <p .course-news-item__summary>
+$#                     #{summary}
+                $of (_, Just summary)
+                  $if not isVisible
+                    <h3 .course-news-item__title>
+                      #{iconInvisible}
+                  <div .div-p .course-news-item__summary>
+                    ^{modal (toWidget summary) (Left (SomeRoute (CNewsR tid ssh csh cID CNShowR)))}
+                $of (Just title, Nothing)
+                  <h3 .course-news-item__title>
+                    #{title}
+                    $if not isVisible
+                      \ #{iconInvisible}
+                  <p .course-news-item__content>
+                    #{courseNewsContent}
+                $of (Nothing, Nothing)
+                  $if not isVisible
+                    <h3 .course-news-item__title>
+                      #{iconInvisible}
+                  <p .course-news-item__content>
+                    #{courseNewsContent}
+              $if showNewsFiles files
+                <ul .course-news-item__files-links .list--inline .list--comma-separated>
+                  $forall (_, fp) <- filter (not . view _1) files
+                    <li .course-news-item__file-link>
+                      <a href=@{CNewsR tid ssh csh cID (CNFileR fp)}>
+                        #{fp}
+              $elseif not (null files)
+                <p .course-news-item__files-link>
+                  <a href=@{CNewsR tid ssh csh cID CNArchiveR}>
+                    #{iconFileZip}
+                    \ _{MsgCourseNewsFiles}
+              <p .course-news-item__last-edit>
+                _{MsgCourseNewsLastEdited lastEditText}
+              <ul .course-news-item__actions .list--inline .list--comma-separated>
+                <li>
+                  ^{modal (i18n MsgCourseNewsActionEdit) (Left (SomeRoute (CNewsR tid ssh csh cID CNEditR)))}
+                <li>
+                  ^{modal (i18n MsgCourseNewsActionDelete) (Left (SomeRoute (CNewsR tid ssh csh cID CNDeleteR)))}
+      $if mayCreateNews
+        <div .div-p>
+          ^{modal (i18n MsgCourseNewsActionCreate) (Left (SomeRoute (CourseR tid ssh csh CNewsNewR)))}
+            
+  
   $maybe descr <- courseDescription course
     <dt .deflist__dt>_{MsgCourseDescription}
     <dd .deflist__dd>
       <div>
         #{descr}
 
+  <dt .deflist__dt>_{MsgCourseSchool}
+  <dd .deflist__dd>
+    #{schoolName}
+
   $with numlecs <- length lecturers
     $if numlecs /= 0
       $if numlecs > 1
@@ -18,10 +77,9 @@ $newline never
       $else
         <dt .deflist__dt>_{MsgLecturerFor}
       <dd .deflist__dd>
-        <div>
+        <ul .list--inline .list--comma-separated>
-          <ul .list--inline .list--comma-separated>
+          $forall lect <- lecturers
-            $forall lect <- lecturers
+            <li>^{nameEmailWidget' lect}
-              <li>^{nameEmailWidget' lect}
   $with numassi <- length assistants
     $if numassi /= 0
       $if numassi > 1
@@ -29,58 +87,53 @@ $newline never
       $else
         <dt .deflist__dt>_{MsgAssistantFor}
       <dd .deflist__dd>
-        <div>
+        <ul .list--inline .list--comma-separated>
-          <ul .list--inline .list--comma-separated>
+          $forall assi <- assistants
-            $forall assi <- assistants
+            <li>^{nameEmailWidget' assi}
-              <li>^{nameEmailWidget' assi}
 
   $with numtutor <- length tutors
     $if numtutor /= 0
       <dt .deflist__dt>_{MsgTutorsFor numtutor}
       <dd .deflist__dd>
-        <div>
+        <ul .list--inline .list--comma-separated>
-          <ul .list--inline .list--comma-separated>
+          $forall tutor <- tutors
-            $forall tutor <- tutors
+            <li>^{nameEmailWidget' tutor}
-              <li>^{nameEmailWidget' tutor}
 
   $with numcorrector <- length correctors
     $if numcorrector /= 0
       <dt .deflist__dt>_{MsgCorrectorsFor numcorrector}
       <dd .deflist__dd>
-        <div>
+        <ul .list--inline .list--comma-separated>
-          <ul .list--inline .list--comma-separated>
+          $forall corrector <- correctors
-            $forall corrector <- correctors
+            <li>^{nameEmailWidget' corrector}
-              <li>^{nameEmailWidget' corrector}
 
   $maybe link <- courseLinkExternal course
-    <dt .deflist__dt>Website
+    <dt .deflist__dt>_{MsgCourseHomepageExternal}
     <dd .deflist__dd>
-      <div>
+      <a href=#{link} target="_blank" rel="noopener" title="_{MsgCourseHomepageExternal}">
-        <a href=#{link} target="_blank" rel="noopener" title="Website des Kurses">#{link}
+        #{iconLink}
+        \ #{link}
 $#    $if NTop (Just 0) < NTop (courseCapacity course)
-  <dt .deflist__dt>Teilnehmer
+  <dt .deflist__dt>_{MsgCourseParticipantsHeading}
   <dd .deflist__dd>
-      <div>
+    $maybe capacity <- courseCapacity course
-        #{participants}
+      _{MsgCourseParticipantsCountOf participants capacity}
-        $maybe capacity <- courseCapacity course
+    $nothing
-          \ von #{capacity}
+      _{MsgCourseParticipantsCount participants}
   $maybe (name, url) <- mAllocation'
     <dt .deflist__dt>_{MsgCourseAllocation}
     <dd .deflist__dd>
       <a href=#{url}>
         #{name}
   $nothing
-    $maybe regFrom <- mRegFrom
+    $maybe regFrom <- courseRegisterFrom course
-      <dt .deflist__dt>Anmeldezeitraum
+      <dt .deflist__dt>_{MsgCourseRegistrationInterval}
       <dd .deflist__dd>
-        <div>
+        <p>
-          Ab #{regFrom}
+          ^{formatTimeRangeW SelFormatDateTime regFrom (courseRegisterTo course)}
-          $maybe regTo <- mRegTo
-            \ bis #{regTo}
         $maybe dereg <- mDereg
-          <div>
+          <p .emph>
-            \ <em>Achtung:</em>
+            _{MsgCourseDeregisterUntil dereg}
-            \ Abmeldung nur bis #{dereg} erlaubt.
   $maybe aInst <- courseApplicationsInstructions course
     <dt .deflist__dt>
       $if courseApplicationsRequired course
@@ -98,7 +151,7 @@ $#    $if NTop (Just 0) < NTop (courseCapacity course)
               _{MsgCourseApplicationTemplateApplication}
             $else
               _{MsgCourseApplicationTemplateRegistration}
-  $if registrationOpen || isJust mRegAt
+  $if registrationOpen || isJust registration
     <dt .deflist__dt>
       _{MsgCourseRegistration}
     <dd .deflist__dd>
@@ -110,20 +163,19 @@ $#    $if NTop (Just 0) < NTop (courseCapacity course)
             <p>
               _{MsgCourseApplicationDeleteToEdit}
           $else
-            $if isJust mRegAt
+            $if isJust registration
               <p>
                 _{MsgCourseRegistrationDeleteToEdit}
-        $maybe date <- mRegAt
+        $maybe CourseParticipant{courseParticipantRegistration} <- registration
-          _{MsgRegisteredSince} #{date}
+          _{MsgRegisteredSince}
+          \ ^{formatTimeW SelFormatDateTime courseParticipantRegistration}
   <dt .deflist__dt>
-    Material
+    _{MsgCourseMaterial}
   <dd .deflist__dd>
-    <div>
+    $if courseMaterialFree course
-      $if courseMaterialFree course
+      _{MsgCourseMaterialFree}
-        Das Kursmaterial ist ohne Anmeldung frei zugänglich.
+    $else
-      $else
+      _{MsgCourseMaterialNotFree}
-        Eine Anmeldung zum Kurs ist Voraussetzung zum Zugang zu Kursmaterial
-        (z.B. Übungsblätter).
   $if hasExams
     <dt .deflist__dt>_{MsgCourseExams}
     <dd .deflist__dd>

templates/course.lucius

@@ -6,3 +6,37 @@ th {
 th, td {
   padding-bottom: 7px;
 }
+
+.course-news {
+    max-height: 50vh;
+    overflow: auto;
+     
+    .course-news-item {
+        padding: 12px 0;
+        border-bottom: 1px solid #d3d3d3;
+
+        &:last-child {
+            padding-bottom: 0;
+            border-bottom: none;
+        }
+        
+        &:first-child {
+            padding-top: 0;
+        }
+
+        .course-news-item__last-edit {
+            color: var(--color-fontsec);
+            font-style: italic;
+        }
+
+        .course-news-item__title .modal__trigger-label {
+            font-style: normal;
+        }
+
+        .course-news-item__summary .modal__trigger-label {
+            font-weight: normal;
+            font-style: normal;
+            color: var(--color-font);
+        }
+    }
+}

templates/default-layout.lucius

@@ -104,6 +104,10 @@ body {
 
 /* END THEMES */
 
+.emph {
+  font-style: italic;
+}
+
 a,
 a:visited {
   text-decoration: none;
@@ -124,7 +128,7 @@ ul {
   margin-left: 20px;
 }
 
-h1, h2, h3, h4, h5 {
+h1, h2, h3, .div-h3 , h4, h5 {
   font-weight: 600;
 }
 h1 {
@@ -134,10 +138,18 @@ h1 {
 h2 {
   font-size: 24px;
   margin: 10px 0;
+
+  &:first-child {
+    margin-top: 0;
+  }
 }
-h3 {
+h3, .div-h3 {
   font-size: 20px;
   margin: 10px 0;
+
+  &:first-child {
+    margin-top: 0;
+  }
 }
 h4 {
   font-size: 16px;
@@ -154,7 +166,7 @@ h4 {
     font-size: 20px;
   }
 
-  h3 {
+  h3, .div-h3 {
     font-size: 16px;
   }
 }
@@ -181,7 +193,7 @@ h4 {
     text-decoration: underline;
   }
 
-  p, form {
+  p, form, .div-p {
     margin: 0.5rem 0;
 
     &:last-child {
@@ -534,7 +546,7 @@ ul.list--inline {
   font-size: 18px;
   margin-bottom: 10px;
 
-  > p {
+  > p, > .div-p {
     margin-top: 0;
   }
 }

templates/i18n/changelog/de.hamlet

@@ -1,5 +1,11 @@
 $newline never
 <dl .deflist>
+  <dt .deflist__dt>
+    ^{formatGregorianW 2019 10 01}
+  <dd .deflist__dd>
+    <ul>
+      <li>"Aktuelles" für Kurse
+
   <dt .deflist__dt>
     ^{formatGregorianW 2019 09 27}
   <dd .deflist__dd>

templates/i18n/info-lecturer/de.hamlet

@@ -124,6 +124,15 @@ $newline text
           <a href=@{AuthPredsR}>Berechtigungen hier temporär selbst entziehen
         . Um die eigene Veranstaltung aus Sicht eines Teilnehmers zu sehen, deaktiviert man #
         die Berechtigungsprüfungen "_{MsgAuthTagLecturer}" und/oder "_{MsgAuthTagCorrector}"
+  
+    <dt .deflist__dt> Aktuelles
+    <dd .deflist__dd>
+      <p>
+        Es lassen sich, direkt auf der Kursübersichtsseite, Neuigkeiten in Bezug
+        auf die Veranstaltung auf der Übersichtsseite publizieren ("Aktuelles").
+      <p>
+        In Zukunft sind ein RSS-Feed und (opt-in) E-Mail-Benachrichtigungen
+        hierfür geplant.
 
 <section>
   <h2>Übungsbetrieb

templates/widgets/delete-confirmation/delete-confirmation.hamlet

@@ -1,10 +1,21 @@
-<p>_{drCaption}
+$newline never
-<ul>
-  $forall (wdgt, _) <- targets
-    <li>
-      ^{wdgt}
 
-<p>_{SomeMessage $ MsgDeleteCopyStringIfSure (Set.size drRecords)}
+<p>_{drCaption}
+
+$case targets
+  $of [(wdgt, _)]
+    <p>^{wdgt}
+  $of _
+    <ul>
+      $forall (wdgt, _) <- targets
+        <li>
+          ^{wdgt}
+
+<p>
+  $if Text.null (Text.strip confirmString)
+    _{SomeMessage $ MsgDeletePressButtonIfSure (Set.size drRecords)}
+  $else
+    _{SomeMessage $ MsgDeleteCopyStringIfSure (Set.size drRecords)}
 
 <p .confirmationText>
   #{confirmString}