From b4df98069982752e36e69571f5557a6179b44cff Mon Sep 17 00:00:00 2001
From: Gregor Kleen <gregor.kleen@ifi.lmu.de>
Date: Tue, 20 Oct 2020 13:06:36 +0200
Subject: [PATCH 1/7] fix(allocations): fix
 allocation-course-accept-substitutes

---
 messages/uniworx/de-de-formal.msg             |   4 +-
 messages/uniworx/en-eu.msg                    |   3 +-
 src/Handler/Course/Edit.hs                    | 112 ++++++++----------
 src/Model/Types/Changelog.hs                  |  19 +--
 ...cept-substitutes-fixed.de-de-formal.hamlet |   2 +
 ...urse-accept-substitutes-fixed.en-eu.hamlet |   2 +
 6 files changed, 70 insertions(+), 72 deletions(-)
 create mode 100644 templates/i18n/changelog/allocation-course-accept-substitutes-fixed.de-de-formal.hamlet
 create mode 100644 templates/i18n/changelog/allocation-course-accept-substitutes-fixed.en-eu.hamlet

diff --git a/messages/uniworx/de-de-formal.msg b/messages/uniworx/de-de-formal.msg
index fff9e6611..c6107bd5e 100644
--- a/messages/uniworx/de-de-formal.msg
+++ b/messages/uniworx/de-de-formal.msg
@@ -262,7 +262,9 @@ CourseApplicationsAllocatedDirectory: zentral
 CourseApplicationsNotAllocatedDirectory: direkt
 
 CourseNoAllocationsAvailable: Es sind aktuell keine Zentralanmeldungen verfügbar
-AllocationStaffRegisterToExpired: Es dürfen keine Änderungen an der Eintragung des Kurses zur Zentralanmeldung mehr vorgenommen werden. Ihre Änderungen wurden ignoriert.
+AllocationStaffRegisterToExpiredAllocation: Die Frist zur Eintrageng von Kursen in die Zentralanmeldung ist verstrichen. Die Teilnahme darf nicht mehr verändert werden.
+AllocationStaffRegisterToExpiredMinCapacity: Die Frist zur Eintrageng von Kursen in die Zentralanmeldung ist verstrichen. Die minimale Kapazität darf nicht mehr verändert werden.
+
 
 
 CourseFormSectionRegistration: Anmeldung zum Kurs
diff --git a/messages/uniworx/en-eu.msg b/messages/uniworx/en-eu.msg
index 74fb98ab2..989eb2b61 100644
--- a/messages/uniworx/en-eu.msg
+++ b/messages/uniworx/en-eu.msg
@@ -262,7 +262,8 @@ CourseApplicationsAllocatedDirectory: central
 CourseApplicationsNotAllocatedDirectory: direct
 
 CourseNoAllocationsAvailable: There are no ongoing central allocations
-AllocationStaffRegisterToExpired: You cannot change course properties concerning the central allocation after the course registration period. Your changes may have been discarded.
+AllocationStaffRegisterToExpiredAllocation: The course registration period for the central allocation is over. Participation may not be changed.
+AllocationStaffRegisterToExpiredMinCapacity: The course registration period for the central allocation is over. Minimum capacity may not be changed.
 
 CourseFormSectionRegistration: Registration
 CourseFormSectionAdministration: Administration
diff --git a/src/Handler/Course/Edit.hs b/src/Handler/Course/Edit.hs
index 7a4fa97eb..9071a9ef0 100644
--- a/src/Handler/Course/Edit.hs
+++ b/src/Handler/Course/Edit.hs
@@ -61,6 +61,9 @@ data AllocationCourseForm = AllocationCourseForm
   , acfDeregisterNoShow          :: Bool
   }
 
+makeLenses_ ''CourseForm
+makeLenses_ ''AllocationCourseForm
+
 courseToForm :: Entity Course -> [Lecturer] -> Map UserEmail (InvitationDBData Lecturer) -> Maybe (Entity AllocationCourse) -> CourseForm
 courseToForm cEnt@(Entity cid Course{..}) lecs lecInvites alloc = CourseForm
     { cfCourseId            = Just cid
@@ -326,20 +329,28 @@ validateCourse = do
   now <- liftIO getCurrentTime
   uid <- liftHandler requireAuthId
   userAdmin <- hasWriteAccessTo $ SchoolR cfSchool SchoolEditR
-  allocationTerm <- for (acfAllocation <$> cfAllocation) $ lift . fmap allocationTerm . getJust
+  newAllocationTerm <- for (acfAllocation <$> cfAllocation) $ lift . fmap allocationTerm . getJust
 
-  oldAllocatedCapacity <- fmap join . for cfCourseId $ \cid -> lift $ do
-    prevAllocationCourse <- getBy $ UniqueAllocationCourse cid
-    prevAllocation <- fmap join . traverse get $ allocationCourseAllocation . entityVal <$> prevAllocationCourse
+  prevAllocationCourse <- join <$> traverse (lift . getBy . UniqueAllocationCourse) cfCourseId
+  prevAllocation <- fmap join . traverse (lift . getEntity) $ allocationCourseAllocation . entityVal <$> prevAllocationCourse
 
-    fmap join . for prevAllocation $ \Allocation{allocationStaffAllocationTo, allocationRegisterByCourse} -> if
-      | userAdmin
-        -> return Nothing
-      | NTop allocationStaffAllocationTo <= NTop (Just now)
-      , NTop allocationRegisterByCourse > NTop (Just now)
-        -> Just . courseCapacity <$> getJust cid
-      | otherwise
-        -> return Nothing
+  oldAllocatedCapacity <- if
+    | Just (Entity _ Allocation{..}) <- prevAllocation
+    , Just (Entity _ AllocationCourse{..}) <- prevAllocationCourse
+    , NTop allocationStaffAllocationTo <= NTop (Just now)
+    , NTop allocationRegisterByCourse > NTop (Just now)
+      -> lift $ Just . courseCapacity <$> getJust allocationCourseCourse
+    | otherwise
+      -> return Nothing
+  let oldAllocation = do
+        Entity allocId Allocation{..} <- prevAllocation
+        guard $ NTop (Just now) > NTop allocationStaffRegisterTo
+        pure $ Just allocId
+      oldAllocatedMinCapacity = do
+        Entity _ Allocation{..} <- prevAllocation
+        Entity _ AllocationCourse{..} <- prevAllocationCourse
+        guard $ NTop (Just now) > NTop allocationStaffRegisterTo
+        pure $ Just allocationCourseMinCapacity
 
   guardValidation MsgCourseVisibilityEndMustBeAfterStart
     $ NTop cfVisFrom <= NTop cfVisTo
@@ -347,15 +358,19 @@ validateCourse = do
     $ NTop cfRegFrom <= NTop cfRegTo
   guardValidation MsgCourseDeregistrationEndMustBeAfterStart
     $ Just False /= ((<=) <$> cfRegFrom <*> cfDeRegUntil)
-  unless userAdmin $
-    guardValidation MsgCourseUserMustBeLecturer
-      $ anyOf (traverse . _Right . _1) (== uid) cfLecturers
   guardValidation MsgCourseAllocationRequiresCapacity
     $ is _Nothing cfAllocation || is _Just cfCapacity
   guardValidation MsgCourseAllocationTermMustMatch
-    $ maybe True (== cfTerm) allocationTerm
-  guardValidation MsgCourseAllocationCapacityMayNotBeChanged
-    $ maybe True (== cfCapacity) oldAllocatedCapacity
+    $ maybe True (== cfTerm) newAllocationTerm
+  unless userAdmin $ do
+    guardValidation MsgCourseUserMustBeLecturer
+      $ anyOf (traverse . _Right . _1) (== uid) cfLecturers
+    guardValidation MsgCourseAllocationCapacityMayNotBeChanged
+      $ maybe True (== cfCapacity) oldAllocatedCapacity
+    guardValidation MsgAllocationStaffRegisterToExpiredAllocation
+      $ maybe True (== fmap acfAllocation cfAllocation) oldAllocation
+    guardValidation MsgAllocationStaffRegisterToExpiredMinCapacity
+      $ maybe True (== fmap acfMinCapacity cfAllocation) oldAllocatedMinCapacity
 
   warnValidation MsgCourseShorthandTooLong
     $ length (CI.original cfShort) <= 10
@@ -567,48 +582,23 @@ courseEditHandler miButtonAction mbCourseForm = do
         }
 
 upsertAllocationCourse :: CourseId -> Maybe AllocationCourseForm -> YesodJobDB UniWorX ()
-upsertAllocationCourse cid cfAllocation = do
-  now <- liftIO getCurrentTime
-  Course{} <- getJust cid
-  prevAllocationCourse <- getBy $ UniqueAllocationCourse cid
-  prevAllocation <- fmap join . traverse getEntity $ allocationCourseAllocation . entityVal <$> prevAllocationCourse
-  userAdmin <- fromMaybe False <$> for prevAllocation (\(Entity _ Allocation{..}) -> hasWriteAccessTo $ SchoolR allocationSchool SchoolEditR)
+upsertAllocationCourse cid = \case
+  Just AllocationCourseForm{..} -> do
+    prevAllocationCourse <- getBy $ UniqueAllocationCourse cid
 
-  doEdit <- if
-    | userAdmin
-      -> return True
-    | Just (Entity _ Allocation{allocationStaffRegisterTo}) <- prevAllocation
-    , NTop allocationStaffRegisterTo <= NTop (Just now)
-      -> let anyChanges
-               | Just AllocationCourseForm{..} <- cfAllocation
-               , Just (Entity _ AllocationCourse{..}) <- prevAllocationCourse
-               = or [ acfAllocation  /= allocationCourseAllocation
-                    , acfMinCapacity /= allocationCourseMinCapacity
-                    ]
-               | otherwise
-               = True
-          in False <$ when anyChanges (addMessageI Error MsgAllocationStaffRegisterToExpired)
-    | otherwise
-      -> return True
+    void $ upsert AllocationCourse
+      { allocationCourseAllocation        =  acfAllocation
+      , allocationCourseCourse            =  cid
+      , allocationCourseMinCapacity       =  acfMinCapacity
+      , allocationCourseAcceptSubstitutes =  acfAcceptSubstitutes
+      }
+      [ AllocationCourseAllocation        =. acfAllocation
+      , AllocationCourseCourse            =. cid
+      , AllocationCourseMinCapacity       =. acfMinCapacity
+      , AllocationCourseAcceptSubstitutes =. acfAcceptSubstitutes
+      ]
 
-  when doEdit $
-    case cfAllocation of
-      Just AllocationCourseForm{..} -> do
-        void $ upsert AllocationCourse
-          { allocationCourseAllocation        =  acfAllocation
-          , allocationCourseCourse            =  cid
-          , allocationCourseMinCapacity       =  acfMinCapacity
-          , allocationCourseAcceptSubstitutes =  acfAcceptSubstitutes
-          }
-          [ AllocationCourseAllocation        =. acfAllocation
-          , AllocationCourseCourse            =. cid
-          , AllocationCourseMinCapacity       =. acfMinCapacity
-          , AllocationCourseAcceptSubstitutes =. acfAcceptSubstitutes
-          ]
-
-        when (Just acfAllocation /= fmap entityKey prevAllocation) $
-          queueDBJob . JobQueueNotification $ NotificationAllocationNewCourse acfAllocation cid
-      Nothing
-        | Just (Entity prevId _) <- prevAllocationCourse
-          -> delete prevId
-      _other -> return ()
+    when (Just acfAllocation /= fmap (allocationCourseAllocation . entityVal) prevAllocationCourse) $
+      queueDBJob . JobQueueNotification $ NotificationAllocationNewCourse acfAllocation cid
+  Nothing ->
+    deleteWhere [ AllocationCourseCourse ==. cid ]
diff --git a/src/Model/Types/Changelog.hs b/src/Model/Types/Changelog.hs
index 828f9a4df..f0b64a502 100644
--- a/src/Model/Types/Changelog.hs
+++ b/src/Model/Types/Changelog.hs
@@ -29,15 +29,16 @@ makePrisms ''ChangelogItemKind
 
 classifyChangelogItem :: ChangelogItem -> ChangelogItemKind
 classifyChangelogItem = \case
-  ChangelogHaskellCampusLogin                    -> ChangelogItemBugfix
-  ChangelogTooltipsWithoutJavascript             -> ChangelogItemBugfix
-  ChangelogButtonsWorkWithoutJavascript          -> ChangelogItemBugfix
-  ChangelogTableFormsWorkAfterAjax               -> ChangelogItemBugfix
-  ChangelogPassingByPointsWorks                  -> ChangelogItemBugfix
-  ChangelogErrorMessagesForTableItemVanish       -> ChangelogItemBugfix
-  ChangelogExamAchievementParticipantDuplication -> ChangelogItemBugfix
-  ChangelogFormsTimesReset                       -> ChangelogItemBugfix
-  _other                                         -> ChangelogItemFeature
+  ChangelogHaskellCampusLogin                     -> ChangelogItemBugfix
+  ChangelogTooltipsWithoutJavascript              -> ChangelogItemBugfix
+  ChangelogButtonsWorkWithoutJavascript           -> ChangelogItemBugfix
+  ChangelogTableFormsWorkAfterAjax                -> ChangelogItemBugfix
+  ChangelogPassingByPointsWorks                   -> ChangelogItemBugfix
+  ChangelogErrorMessagesForTableItemVanish        -> ChangelogItemBugfix
+  ChangelogExamAchievementParticipantDuplication  -> ChangelogItemBugfix
+  ChangelogFormsTimesReset                        -> ChangelogItemBugfix
+  ChangelogAllocationCourseAcceptSubstitutesFixed -> ChangelogItemBugfix
+  _other                                          -> ChangelogItemFeature
 
 changelogItemDays :: Map ChangelogItem Day
 changelogItemDays = Map.fromListWithKey (\k d1 d2 -> bool (error $ "Duplicate changelog days for " <> show k) d1 $ d1 /= d2)
diff --git a/templates/i18n/changelog/allocation-course-accept-substitutes-fixed.de-de-formal.hamlet b/templates/i18n/changelog/allocation-course-accept-substitutes-fixed.de-de-formal.hamlet
new file mode 100644
index 000000000..31106fc32
--- /dev/null
+++ b/templates/i18n/changelog/allocation-course-accept-substitutes-fixed.de-de-formal.hamlet
@@ -0,0 +1,2 @@
+$newline never
+Das Eintragen von Fristen bis zu denen Nachrücker aus Zentralanmeldungen akzeptiert werden ist nun möglich
diff --git a/templates/i18n/changelog/allocation-course-accept-substitutes-fixed.en-eu.hamlet b/templates/i18n/changelog/allocation-course-accept-substitutes-fixed.en-eu.hamlet
new file mode 100644
index 000000000..657c7a162
--- /dev/null
+++ b/templates/i18n/changelog/allocation-course-accept-substitutes-fixed.en-eu.hamlet
@@ -0,0 +1,2 @@
+$newline never
+It is now possible to specify deadlines up to which substitute registrations from central allocations are accepted

From b79bac777c6d349a626ea4efa6c43141b7f669d0 Mon Sep 17 00:00:00 2001
From: Gregor Kleen <gregor.kleen@ifi.lmu.de>
Date: Tue, 20 Oct 2020 15:01:44 +0200
Subject: [PATCH 2/7] feat(allocations): display participant counts to admins

---
 src/Handler/Allocation/Show.hs          |  8 ++++++++
 templates/allocation/show.hamlet        | 10 ++++++++++
 templates/allocation/show/course.hamlet |  9 +++++++++
 3 files changed, 27 insertions(+)

diff --git a/src/Handler/Allocation/Show.hs b/src/Handler/Allocation/Show.hs
index f58b1be58..6cbd6250c 100644
--- a/src/Handler/Allocation/Show.hs
+++ b/src/Handler/Allocation/Show.hs
@@ -61,6 +61,8 @@ postAShowR tid ssh ash = do
     resultCourseVisible = _5 . _Value
     resultAllocationCourse :: _ => Lens' a AllocationCourse
     resultAllocationCourse = _6 . _entityVal
+    resultParticipantCount :: _ => Lens' a Int
+    resultParticipantCount = _7 . _Value
 
   (Entity aId Allocation{..}, School{..}, isAnyLecturer, isAdmin, courses, registration, wouldNotifyNewCourse) <- runDB $ do
     alloc@(Entity aId Allocation{allocationSchool}) <- getBy404 $ TermSchoolAllocationShort tid ssh ash
@@ -81,12 +83,16 @@ postAShowR tid ssh ash = do
       E.orderBy [E.asc $ course E.^. CourseName]
       let hasTemplate = E.exists . E.from $ \courseAppInstructionFile ->
             E.where_ $ courseAppInstructionFile E.^. CourseAppInstructionFileCourse E.==. course E.^. CourseId
+          participantCount = E.subSelectCount . E.from $ \courseParticipant ->
+            E.where_ $ courseParticipant E.^. CourseParticipantCourse E.==. course E.^. CourseId
+                 E.&&. courseParticipant E.^. CourseParticipantState E.==. E.val CourseParticipantActive
       return ( course
              , courseApplication
              , hasTemplate
              , E.not_ . E.isNothing $ registration E.?. CourseParticipantId
              , courseIsVisible now course . Just $ E.val aId
              , allocationCourse
+             , participantCount
              )
 
     registration <- fmap join . for muid $ getBy . UniqueAllocationUser aId
@@ -99,6 +105,7 @@ postAShowR tid ssh ash = do
     return (alloc, school, isAnyLecturer, isAdmin, nubOn (view $ resultCourse . _entityKey) courses, registration, wouldNotifyNewCourse)
 
   let nextSubstitutesDeadline = minimumOf (folded . resultAllocationCourse . _allocationCourseAcceptSubstitutes . _Just . filtered (>= now)) courses
+      freeCapacity = fmap getSum . getAp . flip foldMap courses $ \cEntry -> Ap . fmap (Sum . max 0) $ (subtract $ cEntry ^. resultParticipantCount) <$> preview (resultCourse . _entityVal . _courseCapacity . _Just) cEntry
 
   MsgRenderer mr <- getMsgRenderer
   let title = MsgAllocationTitle (mr . ShortTermIdentifier $ unTermKey allocationTerm) (unSchoolKey allocationSchool) allocationName
@@ -158,6 +165,7 @@ postAShowR tid ssh ash = do
               isRegistered           = cEntry ^. resultIsRegistered
               courseVisible          = cEntry ^. resultCourseVisible
               AllocationCourse{..}   = cEntry ^. resultAllocationCourse
+              partCount              = cEntry ^. resultParticipantCount
           cID <- encrypt cid :: WidgetFor UniWorX CryptoUUIDCourse
           mayApply <- hasWriteAccessTo . AllocationR tid ssh ash $ AApplyR cID
           mayEdit <- hasWriteAccessTo $ CourseR tid ssh courseShorthand CEditR
diff --git a/templates/allocation/show.hamlet b/templates/allocation/show.hamlet
index 9f49e5a3c..5be1369df 100644
--- a/templates/allocation/show.hamlet
+++ b/templates/allocation/show.hamlet
@@ -62,6 +62,16 @@ $newline never
           ^{formatTimeW SelFormatDateTime deadline}
         $nothing
           _{MsgAllocationNextSubstitutesDeadlineNever}
+      <dt .deflist__dt>
+        _{MsgAllocationFreeCapacity} #
+        ^{iconInvisible}
+      <dd .deflist__dd>
+        $maybe freeCap <- freeCapacity
+          #{freeCap}
+          $if freeCap <= 0
+            \ ^{iconOK}
+        $nothing
+          ∞
     $maybe fromT <- allocationRegisterByCourse
       <dt .deflist__dt>
         _{MsgAllocationRegisterByCourseFrom}
diff --git a/templates/allocation/show/course.hamlet b/templates/allocation/show/course.hamlet
index 322b5ea6d..56c967d06 100644
--- a/templates/allocation/show/course.hamlet
+++ b/templates/allocation/show/course.hamlet
@@ -24,6 +24,15 @@ $if isAdmin
         _{MsgCourseAllocationCourseAcceptsSubstitutesNever}
       $if allocationCourseAcceptSubstitutes >= Just now
         \ ^{iconOK}
+    <p>
+      _{MsgCourseAllocationCourseParticipants}:
+      $maybe capacity <- courseCapacity
+        \ _{MsgCourseMembersCountLimited partCount capacity}
+        $if partCount < capacity
+          \ ^{iconProblem}
+      $nothing
+        \ _{MsgCourseMembersCount partCount}
+        \ ^{iconProblem}
 $if hasApplicationTemplate || is _Just courseApplicationsInstructions
   <div .allocation-course__instructions-label .allocation__label>
     _{MsgCourseApplicationInstructionsApplication}

From 48fd6bc7024e3f647591d9e6f0ac101409626394 Mon Sep 17 00:00:00 2001
From: Gregor Kleen <gregor.kleen@ifi.lmu.de>
Date: Tue, 20 Oct 2020 15:32:51 +0200
Subject: [PATCH 3/7] chore: additional faqs

---
 messages/faq/de-de-formal.msg                 |   6 +-
 messages/faq/en-eu.msg                        |   2 +
 messages/uniworx/de-de-formal.msg             |   2 +
 messages/uniworx/en-eu.msg                    |   2 +
 src/Auth/LDAP.hs                              |   3 +-
 src/Handler/Info.hs                           |  24 ++++
 .../allocation-no-places.de-de-formal.hamlet  | 108 ++++++++++++++++++
 .../faq/allocation-no-places.en-eu.hamlet     | 105 +++++++++++++++++
 ...ls-ad-account-disabled.de-de-formal.hamlet |  17 +++
 ...edentials-ad-account-disabled.en-eu.hamlet |  14 +++
 10 files changed, 280 insertions(+), 3 deletions(-)
 create mode 100644 templates/i18n/faq/allocation-no-places.de-de-formal.hamlet
 create mode 100644 templates/i18n/faq/allocation-no-places.en-eu.hamlet
 create mode 100644 templates/i18n/faq/invalid-credentials-ad-account-disabled.de-de-formal.hamlet
 create mode 100644 templates/i18n/faq/invalid-credentials-ad-account-disabled.en-eu.hamlet

diff --git a/messages/faq/de-de-formal.msg b/messages/faq/de-de-formal.msg
index 092366c09..bc424609f 100644
--- a/messages/faq/de-de-formal.msg
+++ b/messages/faq/de-de-formal.msg
@@ -1,6 +1,8 @@
 FAQNoCampusAccount: Ich habe keine LMU-Benutzerkennung (ehem. Campus-Kennung); kann ich trotzdem Zugang zum System erhalten?
 FAQForgottenPassword: Ich habe mein Passwort vergessen
 FAQCampusCantLogin: Ich kann mich mit meiner LMU-Benutzerkennung (ehem. Campus-Kennung) nicht anmelden
-FAQCourseCorrectorsTutors: Wie kann ich Tutoren oder Korrektoren für meinen Kurs einstellen?
+FAQCourseCorrectorsTutors: Wie kann ich Tutoren oder Korrektoren für meinen Kurs konfigurieren?
 FAQNotLecturerHowToCreateCourses: Wie kann ich einen neuen Kurs anlegen?
-FAQExamPoints: Warum kann ich bei meiner Klausur keine Punkte eintragen?
\ No newline at end of file
+FAQExamPoints: Warum kann ich bei meiner Klausur keine Punkte eintragen?
+FAQInvalidCredentialsAdAccountDisabled: Ich kann mich nicht anmelden und bekomme die Meldung „Benutzereintrag gesperrt“
+FAQAllocationNoPlaces: Ich habe über eine Zentralanmeldung keine Plätze/nicht die Plätze, die ich möchte, erhalten
\ No newline at end of file
diff --git a/messages/faq/en-eu.msg b/messages/faq/en-eu.msg
index 1cce5d04b..51c56628f 100644
--- a/messages/faq/en-eu.msg
+++ b/messages/faq/en-eu.msg
@@ -4,3 +4,5 @@ FAQCampusCantLogin: I can't log in using my LMU user ID (formerly Campus-ID)
 FAQCourseCorrectorsTutors: How can I add tutors or correctors to my course?
 FAQNotLecturerHowToCreateCourses: How can I create new courses?
 FAQExamPoints: Why can't I enter achievements for my exam as points?
+FAQInvalidCredentialsAdAccountDisabled: I can't log in and am instead given the message “Account disabled”
+FAQAllocationNoPlaces: I did not receive any places/the places I wanted from a central allocation
\ No newline at end of file
diff --git a/messages/uniworx/de-de-formal.msg b/messages/uniworx/de-de-formal.msg
index c6107bd5e..6d76bf8c5 100644
--- a/messages/uniworx/de-de-formal.msg
+++ b/messages/uniworx/de-de-formal.msg
@@ -206,6 +206,7 @@ CourseAllocationMinCapacityTip: Wenn der Veranstaltung bei der Zentralanmeldung
 CourseAllocationMinCapacityMustBeNonNegative: Minimale Teilnehmeranzahl darf nicht negativ sein
 CourseAllocationCourseAcceptsSubstitutesUntil: Akzeptiert Nachrücker bis
 CourseAllocationCourseAcceptsSubstitutesNever: Akzeptiert keine Nachrücker
+CourseAllocationCourseParticipants: Teilnehmer
 CourseApplicationInstructions: Anweisungen zur Bewerbung/Anmeldung
 CourseApplicationInstructionsTip: Wird den Studierenden angezeigt, wenn diese sich für Ihre Veranstaltung bewerben bzw. bei dieser anmelden
 CourseApplicationTemplate: Bewerbungsvorlagen
@@ -2271,6 +2272,7 @@ AllocationNotificationNewCourseCurrentlyOn: Aktuell würden Sie benachrichtigt w
 AllocationNotificationLoginFirst: Um Ihre Benachrichtigungseinstellungen zu ändern, loggen Sie sich bitte zunächst ein.
 AllocationNextSubstitutesDeadline: Nächster Kurs akzeptiert Nachrücker bis
 AllocationNextSubstitutesDeadlineNever: Keine Kurse akzeptieren mehr Nachrücker
+AllocationFreeCapacity: Freie Plätze
 
 AllocationSchoolShort: Institut
 Allocation: Zentralanmeldung
diff --git a/messages/uniworx/en-eu.msg b/messages/uniworx/en-eu.msg
index 989eb2b61..e823b35ba 100644
--- a/messages/uniworx/en-eu.msg
+++ b/messages/uniworx/en-eu.msg
@@ -206,6 +206,7 @@ CourseAllocationMinCapacityTip: If fewer students than this number were to be as
 CourseAllocationMinCapacityMustBeNonNegative: Minimum number of participants must not be negative
 CourseAllocationCourseAcceptsSubstitutesUntil: Accepts substitutes until
 CourseAllocationCourseAcceptsSubstitutesNever: Does not accept substitutes
+CourseAllocationCourseParticipants: Participants
 CourseApplicationInstructions: Instructions for application
 CourseApplicationInstructionsTip: Will be shown to students if they decide to apply for this course
 CourseApplicationTemplate: Application template
@@ -2270,6 +2271,7 @@ AllocationNotificationNewCourseCurrentlyOn: Currently you would be notified.
 AllocationNotificationLoginFirst: To change your notification settings, please log in first.
 AllocationNextSubstitutesDeadline: Next course accepts substitutes until
 AllocationNextSubstitutesDeadlineNever: No course currently accepts substitutes
+AllocationFreeCapacity: Free capacity
 
 AllocationSchoolShort: Department
 Allocation: Central allocation
diff --git a/src/Auth/LDAP.hs b/src/Auth/LDAP.hs
index 471e59dd7..597163cd4 100644
--- a/src/Auth/LDAP.hs
+++ b/src/Auth/LDAP.hs
@@ -160,6 +160,7 @@ campusUserMatr' pool mode
 
 newtype ADInvalidCredentials = ADInvalidCredentials ADError
   deriving (Eq, Ord, Read, Show, Generic, Typeable)
+  deriving newtype (Universe, Finite, Enum, Bounded, PathPiece, ToJSON, FromJSON, ToJSONKey, FromJSONKey)
 
 isUnusualADError :: ADError -> Bool
 isUnusualADError = flip notElem [ADNoSuchObject, ADLogonFailure]
@@ -220,7 +221,7 @@ campusLogin pool mode = AuthPlugin{..}
                 $logInfoS apName [st|#{campusIdent}: #{toPathPiece adError}|]
                 observeLoginOutcome apName LoginADInvalidCredentials
                 MsgRenderer mr <- liftHandler getMsgRenderer
-                setSessionJson SessionError . PermissionDenied . mr $ ADInvalidCredentials adError
+                setSessionJson SessionError . PermissionDenied . toPathPiece $ ADInvalidCredentials adError
                 loginErrorMessage (tp LoginR) . mr $ ADInvalidCredentials adError
           Right (Left bindErr) -> do
             case bindErr of
diff --git a/src/Handler/Info.hs b/src/Handler/Info.hs
index 99a748da2..43110c6cc 100644
--- a/src/Handler/Info.hs
+++ b/src/Handler/Info.hs
@@ -14,6 +14,8 @@ import qualified Database.Esqueleto.Utils as E
 
 import Development.GitRev
 
+import Auth.LDAP (ADError(..), ADInvalidCredentials(..))
+
 -- | Versionsgeschichte
 getVersionR :: Handler TypedContent
 getVersionR = selectRep $ do
@@ -181,6 +183,26 @@ showFAQ (CExamR tid ssh csh examn _) FAQExamPoints
            E.&&. course E.^. CourseSchool E.==. E.val ssh
            E.&&. course E.^. CourseShorthand E.==. E.val csh
            E.&&. exam E.^. ExamName E.==. E.val examn
+showFAQ _ FAQInvalidCredentialsAdAccountDisabled = maybeT (return False) $ do
+  guardM $ is _Nothing <$> maybeAuthId
+  sessionError <- MaybeT $ lookupSessionJson SessionError
+  guard $ sessionError == PermissionDenied (toPathPiece $ ADInvalidCredentials ADAccountDisabled)
+  return True
+showFAQ _ FAQAllocationNoPlaces = maybeT (return False) $ do
+  uid <- MaybeT maybeAuthId
+  now <- liftIO getCurrentTime
+  liftHandler . runDB . E.selectExists . E.from $ \allocation -> do
+    let doneSince = E.subSelectMaybe . E.from $ \participant -> do
+          E.where_ $ participant E.^. CourseParticipantAllocated E.==. E.just (allocation E.^. AllocationId)
+          return . E.max_ $ participant E.^. CourseParticipantRegistration
+        isAllocationUser = E.exists . E.from $ \allocationUser ->
+          E.where_ $ allocationUser E.^. AllocationUserAllocation E.==. allocation E.^. AllocationId
+               E.&&. allocationUser E.^. AllocationUserUser E.==. E.val uid
+        isApplicant = E.exists . E.from $ \courseApplication ->
+          E.where_ $ courseApplication E.^. CourseApplicationAllocation E.==. E.just (allocation E.^. AllocationId)
+               E.&&. courseApplication E.^. CourseApplicationUser E.==. E.val uid
+    E.where_ $ isAllocationUser E.||. isApplicant
+    E.where_ $ E.maybe E.false (\done -> done E.>=. E.val (addUTCTime (-7 * nominalDay) now)) doneSince
 showFAQ _ _ = return False
 
 prioFAQ :: Monad m
@@ -191,3 +213,5 @@ prioFAQ _ FAQForgottenPassword = return 1
 prioFAQ _ FAQNotLecturerHowToCreateCourses = return 1
 prioFAQ _ FAQCourseCorrectorsTutors = return 1
 prioFAQ _ FAQExamPoints = return 2
+prioFAQ _ FAQAllocationNoPlaces = return 2
+prioFAQ _ FAQInvalidCredentialsAdAccountDisabled = return 3  
diff --git a/templates/i18n/faq/allocation-no-places.de-de-formal.hamlet b/templates/i18n/faq/allocation-no-places.de-de-formal.hamlet
new file mode 100644
index 000000000..55c53c6e5
--- /dev/null
+++ b/templates/i18n/faq/allocation-no-places.de-de-formal.hamlet
@@ -0,0 +1,108 @@
+$newline never
+<p>
+  Die Plätze in den Zentralanmeldungen werden nach den folgenden #
+  Kriterien verteilt (in grober Reihenfolge des Einfluss, den sie auf #
+  die Verteilung haben):
+
+<ul>
+  <li>
+    Die eigene Priorisierung der Bewerbung (1. Wahl, etc.)
+
+    <br />
+
+    Die Priorisierung hat jedoch nur eine ordnende Funktion und #
+    diese auch nur innerhalb der Bewerbungen eines einzelnen #
+    Bewerbers. #
+
+    Die genauen Zahlen sind also bedeutungslos und werden auch nicht #
+    unter den Bewerbern verglichen.
+
+  <li>
+
+    Studienfortschritt (gemessen am Prozentsatz der für den Abschluss #
+    erforderlichen Veranstaltungen, die bereits bestanden wurden), #
+    nicht jedoch das Fach- oder Hochschulsemester
+
+    <br />
+
+    Den aus dem Studienfortschritt errechnet Parameter nennt Uni2work #
+    die „zentrale Dringlichkeit“.
+
+  <li>
+    
+    Etwaige Bewertungen der Bewerbungen durch die Kursverwalter
+
+<p>
+  
+  Wenn Sie also keine Plätze in der Zentralanmeldung erhalten haben, #
+  liegt dies für gewöhnlich daran, dass Ihre zentrale Dringlichkeit in #
+  dieser Vergabe zu gering war und stattdessen andere Bewerber, mit #
+  weiter fortgeschrittenem Studium, Plätze erhalten haben.
+
+  <br />
+
+  Ebenso kann es sein, dass Sie nicht Ihre erste Wahl erhalten, wenn #
+  diese unter Studierenden mit höherer Dringlichkeit beliebt ist.
+
+  <br />
+
+  So wird sichergestellt, dass der Studienabschluss nicht durch #
+  fehlende Credits verzögert wird, die nur in Kursen erreicht werden #
+  können, die an einer Zentralanmeldung teilnehmen.
+
+<p>
+  
+  Für gewöhnlich gibt es zu jeder Zentralanmeldung auch ein #
+  Nachrückerverfahren. #
+
+  Es werden hierfür auf Basis der Bewerbungen für die #
+  Zentralanmeldungen Plätze, die wieder frei werden, erneut verteilt.
+
+  <br />
+
+  Die Kriterien für diese Verteilungen sind die selben, wie auch bei #
+  der ursprünglichen Verteilung. #
+
+  <br />
+
+  Wenn Sie sich bereits in der Zentralanmeldung beworben haben, ist #
+  eine gesonderte Anmeldung oder Bewerbung als Nachrücker nicht #
+  erforderlich. #
+
+  Sie werden automatisch benachrichtigt, falls Sie über das #
+  Nachrückerverfahren doch noch einen Platz bzw. zusätzliche Plätze #
+  erhalten (außer Sie haben diese Benachrichtigung aktiv unter #
+  „Anpassen“ ausgeschaltet).
+  
+<p>
+  Um in der nächsten Zentralanmeldung eine bessere Chance auf einen #
+  Platz zu haben können Sie folgende Schritte ergreifen:
+
+<ul>
+  <li>
+    Für möglichst viele der angebotenen Kurse bewerben
+
+    <br />
+
+    Bei gleicher zentraler Dringlichkeit haben Bewerber, die mehr #
+    Bewerbungen einreichen, eine signifikant bessere Chance einen #
+    Platz zu erhalten.
+  
+  <li>
+    Normal weiter studieren
+
+    <br />
+
+    Durch zusätzliche bestandene Leistungen wird sich Ihr #
+    Studienfortschritt und somit Ihre zentrale Dringlichkeit erhöhen.
+
+  <li>
+    Bessere Bewerbungen einreichen
+
+    <br />
+
+    Eine gute Bewertung der Bewerbung kann einen beträchtlichen #
+    Unterschied in zentraler Dringlichkeit ausgleichen. #
+
+    Wenn Ihre Bewerbungen von den Kursverwaltern gut bewertet werden, #
+    haben Sie eine bessere Chance auf einen Platz.
diff --git a/templates/i18n/faq/allocation-no-places.en-eu.hamlet b/templates/i18n/faq/allocation-no-places.en-eu.hamlet
new file mode 100644
index 000000000..d3572f43c
--- /dev/null
+++ b/templates/i18n/faq/allocation-no-places.en-eu.hamlet
@@ -0,0 +1,105 @@
+$newline never
+<p>
+  Placements in central allocations are allocated according to the #
+  following criteria (ordered roughly by their impact on the #
+  allocation):
+
+<ul>
+  <li>
+    The priority of the application (1st Choice, etc.)
+
+    <br />
+
+    The priority is only used to order the applications in the context #
+    of a single applicant. #
+
+    Therefore the exact numerical values are inconsequential and are #
+    not compared between applicants.
+
+  <li>
+    Study progress (measured by the number ECTS credits achieved as a #
+    percentage of those required for graduation) but not (university) #
+    semesters
+
+    <br />
+
+    The parameter calculated from study progress is referred to within #
+    Uni2work as “central priority”.
+
+  <li>
+    Ratings of applications by course administrators
+
+<p>
+  If you were not allocated any placements this is usually because #
+  your central priority was too low. #
+ 
+  Instead other applicants with higher central priority, and thus a #
+  higher degree of study progress, have received placements.
+
+  <br />
+
+  Accordingly you may not have received the placements you wanted #
+  because the respective courses were popular among applicants with #
+  higher central priority.
+
+  <br />
+
+  This method of allocation ensures that graduation is not impeded by #
+  missing credits which can only be gained through courses which #
+  participate in a central allocation.
+
+<p>
+  
+  There usually is a process for substitute registrations. #
+
+  Places that become free after the initial allocation are assigned #
+  again on the basis of the existing applications.
+
+  <br />
+
+  The criteria for the allocation of placements are the same as for #
+  the initial allocation.
+
+  <br />
+
+  If you have already applied for the central allocation no further #
+  registration or application is necessary to be assigned a substitute #
+  registration. #
+
+  You will be notified automatically if you are assigned additional #
+  placements (unless you have actively disabled the notification under #
+  “Settings”).
+
+<p>
+
+  To improve your chances of being allocated a placement during the #
+  next central allocation, you may try the following:
+
+<ul>
+  <li>
+    Apply for as many courses as possible
+
+    <br />
+
+    Of two applicants with the same central priority, the one who #
+    applied for more courses has a significantly better chance of #
+    being allocated a placement.
+
+  <li>
+    Continue your studies normally
+
+    <br />
+
+    Through achieving additional credits your degree of study progress #
+    will improve and thus your central priority will, too.
+
+  <li>
+    Write better applications
+
+    <br />
+
+    Having an application rated well can ameliorate a considerable #
+    difference in central priority. #
+  
+    If your applications are rated well by course administrators your #
+    chances to be allocated a placement improve.
diff --git a/templates/i18n/faq/invalid-credentials-ad-account-disabled.de-de-formal.hamlet b/templates/i18n/faq/invalid-credentials-ad-account-disabled.de-de-formal.hamlet
new file mode 100644
index 000000000..117add24d
--- /dev/null
+++ b/templates/i18n/faq/invalid-credentials-ad-account-disabled.de-de-formal.hamlet
@@ -0,0 +1,17 @@
+$newline never
+
+<p>
+  Gewöhnlicherweise wird Ihr Benutzereintrag gesperrt, wenn sie #
+  exmatrikuliert werden bzw. Ihr Beschäftigungsverhältnis endet. #
+
+  Es kommt gelegentlich vor, dass Ihr Benutzereintrag nicht korrekt #
+  entsperrt wird, wenn Sie wieder immatrikuliert bzw. eingestellt #
+  werden.
+  
+<p>
+  Falls Sie aktuell immatrikuliert bzw. eingestellt sind, oder Sie #
+  einen anderen triftigen Grund vorweisen können, warum Sie Zugang zu #
+  Uni2work brauchen, wenden Sie sich bitte über #
+  das <a href=@{HelpR}>Hilfe-Formular</a>, oben rechts auf jeder #
+  Seite, an die Uni2work-Administration und schildern Sie Ihre #
+  Situation.
diff --git a/templates/i18n/faq/invalid-credentials-ad-account-disabled.en-eu.hamlet b/templates/i18n/faq/invalid-credentials-ad-account-disabled.en-eu.hamlet
new file mode 100644
index 000000000..9e2df00f4
--- /dev/null
+++ b/templates/i18n/faq/invalid-credentials-ad-account-disabled.en-eu.hamlet
@@ -0,0 +1,14 @@
+$newline never
+
+<p>
+  Usually your account is disabled once you are no longer matriculated #
+  (i.e. registered as a student) or employed. #
+
+  Occasionally accounts are not correctly re-enabled once you are #
+  matriculated or employed, again.
+
+<p>
+  If you are currently matriculated, employed, or have another good #
+  reason why you should have access to Uni2work, please contact a #
+  Uni2work-Administrator using the <a href=@{HelpR}>Support form</a> #
+  (at the top right of every page) and describe your situation.

From 64c8f9ab3de3736bd97f79b5567fc0e559495514 Mon Sep 17 00:00:00 2001
From: Gregor Kleen <gregor.kleen@ifi.lmu.de>
Date: Tue, 20 Oct 2020 15:58:05 +0200
Subject: [PATCH 4/7] refactor: hlint

---
 src/Handler/Allocation/Show.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/Handler/Allocation/Show.hs b/src/Handler/Allocation/Show.hs
index 6cbd6250c..432566344 100644
--- a/src/Handler/Allocation/Show.hs
+++ b/src/Handler/Allocation/Show.hs
@@ -105,7 +105,7 @@ postAShowR tid ssh ash = do
     return (alloc, school, isAnyLecturer, isAdmin, nubOn (view $ resultCourse . _entityKey) courses, registration, wouldNotifyNewCourse)
 
   let nextSubstitutesDeadline = minimumOf (folded . resultAllocationCourse . _allocationCourseAcceptSubstitutes . _Just . filtered (>= now)) courses
-      freeCapacity = fmap getSum . getAp . flip foldMap courses $ \cEntry -> Ap . fmap (Sum . max 0) $ (subtract $ cEntry ^. resultParticipantCount) <$> preview (resultCourse . _entityVal . _courseCapacity . _Just) cEntry
+      freeCapacity = fmap getSum . getAp . flip foldMap courses $ \cEntry -> Ap . fmap (Sum . max 0) $ subtract (cEntry ^. resultParticipantCount) <$> preview (resultCourse . _entityVal . _courseCapacity . _Just) cEntry
 
   MsgRenderer mr <- getMsgRenderer
   let title = MsgAllocationTitle (mr . ShortTermIdentifier $ unTermKey allocationTerm) (unSchoolKey allocationSchool) allocationName

From 94b7ac74c187a0abfda48833b992d90935150b1a Mon Sep 17 00:00:00 2001
From: Gregor Kleen <gregor.kleen@ifi.lmu.de>
Date: Tue, 20 Oct 2020 16:03:15 +0200
Subject: [PATCH 5/7] chore(release): 20.13.0

---
 CHANGELOG.md      | 12 ++++++++++++
 package-lock.json |  2 +-
 package.json      |  2 +-
 package.yaml      |  2 +-
 4 files changed, 15 insertions(+), 3 deletions(-)

diff --git a/CHANGELOG.md b/CHANGELOG.md
index 87274836d..5ce661834 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -2,6 +2,18 @@
 
 All notable changes to this project will be documented in this file. See [standard-version](https://github.com/conventional-changelog/standard-version) for commit guidelines.
 
+## [20.13.0](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/compare/v20.12.1...v20.13.0) (2020-10-20)
+
+
+### Features
+
+* **allocations:** display participant counts to admins ([b79bac7](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/b79bac777c6d349a626ea4efa6c43141b7f669d0))
+
+
+### Bug Fixes
+
+* **allocations:** fix allocation-course-accept-substitutes ([b4df980](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/b4df98069982752e36e69571f5557a6179b44cff))
+
 ### [20.12.1](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/compare/v20.12.0...v20.12.1) (2020-10-14)
 
 
diff --git a/package-lock.json b/package-lock.json
index aada929cb..d52c1250a 100644
--- a/package-lock.json
+++ b/package-lock.json
@@ -1,6 +1,6 @@
 {
   "name": "uni2work",
-  "version": "20.12.1",
+  "version": "20.13.0",
   "lockfileVersion": 1,
   "requires": true,
   "dependencies": {
diff --git a/package.json b/package.json
index 7270318df..c9ed90296 100644
--- a/package.json
+++ b/package.json
@@ -1,6 +1,6 @@
 {
   "name": "uni2work",
-  "version": "20.12.1",
+  "version": "20.13.0",
   "description": "",
   "keywords": [],
   "author": "",
diff --git a/package.yaml b/package.yaml
index e89d9721b..fa6071e8e 100644
--- a/package.yaml
+++ b/package.yaml
@@ -1,5 +1,5 @@
 name:    uniworx
-version: 20.12.1
+version: 20.13.0
 
 dependencies:
   - base

From ca29a66330a977a1f28bbdbe9a733aef10371427 Mon Sep 17 00:00:00 2001
From: Gregor Kleen <gregor.kleen@ifi.lmu.de>
Date: Mon, 26 Oct 2020 16:27:02 +0100
Subject: [PATCH 6/7] fix(exams): error messages for foreign key constraint
 violations

---
 messages/uniworx/de-de-formal.msg |  2 ++
 messages/uniworx/en-eu.msg        |  2 ++
 src/Handler/Exam/Edit.hs          | 25 +++++++-------
 src/Handler/Exam/Form.hs          | 56 +++++++++++++++++++++++++------
 src/Handler/Exam/New.hs           | 23 +++++++------
 src/Utils.hs                      | 12 +++----
 6 files changed, 80 insertions(+), 40 deletions(-)

diff --git a/messages/uniworx/de-de-formal.msg b/messages/uniworx/de-de-formal.msg
index 6d76bf8c5..27e53f34e 100644
--- a/messages/uniworx/de-de-formal.msg
+++ b/messages/uniworx/de-de-formal.msg
@@ -1950,6 +1950,8 @@ ExamOccurrenceStartMustBeAfterExamStart eoName@ExamOccurrenceName: Beginn des Te
 ExamOccurrenceEndMustBeBeforeExamEnd eoName@ExamOccurrenceName: Ende des Termins #{eoName} liegt nach dem Ende der Prüfung
 ExamOccurrenceDuplicate eoRoom@Text eoRange@Text: Raum #{eoRoom}, Termin #{eoRange} kommt mehrfach mit der selben Beschreibung vor
 ExamOccurrenceDuplicateName eoName@ExamOccurrenceName: Interne Terminbezeichnung #{eoName} kommt mehrfach vor
+ExamOccurrenceCannotBeDeletedDueToRegistrations eoName@ExamOccurrenceName: Termin #{eoName} kann nicht gelöscht werden, da noch Teilnehmer diesem Termin zugewiesen sind. Über die Liste von Prüfungsteilnehmern können Sie zunächst die entsprechenden Terminzuweisungen entfernen.
+ExamPartCannotBeDeletedDueToResults exampartnum@ExamPartNumber: Teil #{exampartnum} kann nicht gelöscht werden, da bereits Prüfungsergebnisse für diesen Teil eingetragen wurden.
 
 VersionHistory: Versionsgeschichte
 KnownBugs: Bekannte Bugs
diff --git a/messages/uniworx/en-eu.msg b/messages/uniworx/en-eu.msg
index e823b35ba..437215ed3 100644
--- a/messages/uniworx/en-eu.msg
+++ b/messages/uniworx/en-eu.msg
@@ -1949,6 +1949,8 @@ ExamOccurrenceStartMustBeAfterExamStart eoName: Start of the occurrence #{eoName
 ExamOccurrenceEndMustBeBeforeExamEnd eoName: End of the occurrence #{eoName} must be before the exam end
 ExamOccurrenceDuplicate eoRoom eoRange: Combination of room #{eoRoom} and occurrence #{eoRange} occurs multiple times
 ExamOccurrenceDuplicateName eoName: Internal name #{eoName} occurs multiple times
+ExamOccurrenceCannotBeDeletedDueToRegistrations eoName: Occurrence #{eoName} cannot be deleted because participants are registered for it. You can remove the offending registrations via the list of exam participants.
+ExamPartCannotBeDeletedDueToResults exampartnum: Part #{exampartnum} cannot be deleted because some exam part results were already entered for it.
 
 VersionHistory: Version history
 KnownBugs: Known bugs
diff --git a/src/Handler/Exam/Edit.hs b/src/Handler/Exam/Edit.hs
index 7478479a4..7cc3ef518 100644
--- a/src/Handler/Exam/Edit.hs
+++ b/src/Handler/Exam/Edit.hs
@@ -18,17 +18,14 @@ import Jobs.Queue
 getEEditR, postEEditR :: TermId -> SchoolId -> CourseShorthand -> ExamName -> Handler Html
 getEEditR = postEEditR
 postEEditR tid ssh csh examn = do
-  (cid, Entity eId oldExam, template) <- runDB $ do
-    (cid, exam) <- fetchCourseIdExam tid ssh csh examn
+  (template, (editExamAct, (editExamWidget, editExamEnctype))) <- runDBJobs $ do
+    (cid, exam@(Entity eId oldExam)) <- fetchCourseIdExam tid ssh csh examn
 
     template <- examFormTemplate exam
 
-    return (cid, exam, template)
+    ((editExamResult, editExamWidget), editExamEnctype) <- runFormPost . validateForm (validateExam cid $ Just exam) . examForm $ Just template
 
-  ((editExamResult, editExamWidget), editExamEnctype) <- runFormPost . validateForm (validateExam cid $ Just oldExam) . examForm $ Just template
-
-  formResult editExamResult $ \ExamForm{..} -> do
-    insertRes <- runDBJobs $ do
+    editExamAct <- formResultMaybe editExamResult $ \ExamForm{..} -> do
       insertRes <- myReplaceUnique eId Exam
         { examCourse           = cid
         , examName             = efName
@@ -116,13 +113,15 @@ postEEditR tid ssh csh examn = do
         deleteWhere [ InvitationFor ==. invRef @ExamCorrector eId, InvitationEmail /<-. invites ]
         sinkInvitationsF examCorrectorInvitationConfig $ map (, eId, (InvDBDataExamCorrector, InvTokenDataExamCorrector)) invites
 
-      return insertRes
+      return . Just $ case insertRes of
+        Just _  -> addMessageI Error $ MsgExamNameTaken efName
+        Nothing -> do
+          addMessageI Success $ MsgExamEdited efName
+          redirect $ CExamR tid ssh csh efName EShowR
 
-    case insertRes of
-      Just _  -> addMessageI Error $ MsgExamNameTaken efName
-      Nothing -> do
-        addMessageI Success $ MsgExamEdited efName
-        redirect $ CExamR tid ssh csh efName EShowR
+    return (template, (editExamAct, (editExamWidget, editExamEnctype)))
+
+  sequence_ editExamAct
 
   let heading = prependCourseTitle tid ssh csh . MsgExamEditHeading $ efName template
 
diff --git a/src/Handler/Exam/Form.hs b/src/Handler/Exam/Form.hs
index 1fe31be33..2a19dfa4f 100644
--- a/src/Handler/Exam/Form.hs
+++ b/src/Handler/Exam/Form.hs
@@ -98,11 +98,14 @@ deriveJSON defaultOptions
   } ''ExamOccurrenceForm
 
 
-examForm :: Maybe ExamForm -> Form ExamForm
-examForm template html = do
+examForm :: ( MonadHandler m
+            , HandlerSite m ~ UniWorX
+            )
+         => Maybe ExamForm -> (Html -> MForm m (FormResult ExamForm, Widget))
+examForm template csrf = hoist liftHandler $ do
   MsgRenderer mr <- getMsgRenderer
 
-  flip (renderAForm FormStandard) html $ ExamForm
+  flip (renderAForm FormStandard) csrf $ ExamForm
     <$> areq ciField (fslpI MsgExamName (mr MsgExamName) & setTooltip MsgExamNameTip) (efName <$> template)
     <*> aopt htmlField (fslI MsgExamDescription) (efDescription <$> template)
     <*  aformSection MsgExamFormTimes
@@ -284,7 +287,11 @@ examPartsForm prev = wFormToAForm $ do
     miIdent' :: Text
     miIdent' = "exam-parts"
 
-examFormTemplate :: Entity Exam -> DB ExamForm
+examFormTemplate :: ( MonadHandler m
+                    , HandlerSite m ~ UniWorX
+                    , MonadThrow m
+                    )
+                 => Entity Exam -> SqlPersistT m ExamForm
 examFormTemplate (Entity eId Exam{..}) = do
   examParts <- selectList [ ExamPartExam ==. eId ] []
   occurrences <- selectList [ ExamOccurrenceExam ==. eId ] []
@@ -342,7 +349,8 @@ examFormTemplate (Entity eId Exam{..}) = do
     , efStaff            = examStaff
     }
 
-examTemplate :: CourseId -> DB (Maybe ExamForm)
+examTemplate :: MonadHandler m
+             => CourseId -> SqlPersistT m (Maybe ExamForm)
 examTemplate cid = runMaybeT $ do
   newCourse <- MaybeT $ get cid
 
@@ -393,7 +401,12 @@ examTemplate cid = runMaybeT $ do
     }
 
 
-validateExam :: (MonadHandler m, HandlerSite m ~ UniWorX) => CourseId -> Maybe Exam -> FormValidator ExamForm m ()
+validateExam :: forall m.
+                ( MonadHandler m
+                , HandlerSite m ~ UniWorX
+                , MonadThrow m
+                )
+             => CourseId -> Maybe (Entity Exam) -> FormValidator ExamForm (SqlPersistT m) ()
 validateExam cId oldExam = do
   ExamForm{..} <- State.get
 
@@ -404,6 +417,7 @@ validateExam cId oldExam = do
   guardValidation MsgExamFinishedMustBeAfterEnd   $ Just False /= ((>=) <$> efFinished <*> efEnd)
   guardValidation MsgExamFinishedMustBeAfterStart $ Just False /= ((>=) <$> efFinished <*> efStart)
 
+
   forM_ efOccurrences $ \ExamOccurrenceForm{..} -> do
     guardValidation (MsgExamOccurrenceEndMustBeAfterStart eofName)       $ NTop eofEnd >= NTop (Just eofStart)
     guardValidation (MsgExamOccurrenceStartMustBeAfterExamStart eofName) $ NTop (Just eofStart) >= NTop efStart
@@ -421,6 +435,28 @@ validateExam cId oldExam = do
 
     guardValidation (MsgExamOccurrenceDuplicateName $ eofName a) $ ((/=) `on` eofName) a b
 
+  oldOccurrencesWithRegistrations <- for oldExam $ \(Entity eId _) -> lift . E.select . E.from $ \examOccurrence -> do
+    E.where_ $ examOccurrence E.^. ExamOccurrenceExam E.==. E.val eId
+    E.where_ . E.exists . E.from $ \examRegistration ->
+      E.where_ $ examRegistration E.^. ExamRegistrationOccurrence E.==. E.just (examOccurrence E.^. ExamOccurrenceId)
+    return ( examOccurrence E.^. ExamOccurrenceId
+           , examOccurrence E.^. ExamOccurrenceName
+           )
+  forM_ (join $ hoistMaybe oldOccurrencesWithRegistrations) $ \(E.Value eoId, E.Value eoName) ->
+    guardValidationM (MsgExamOccurrenceCannotBeDeletedDueToRegistrations eoName) . anyM (otoList efOccurrences) $ \ExamOccurrenceForm{..} -> (== Just eoId) <$> traverse decrypt eofId
+
+
+  oldPartsWithResults <- for oldExam $ \(Entity eId _) -> lift . E.select . E.from $ \examPart -> do
+    E.where_ $ examPart E.^. ExamPartExam E.==. E.val eId
+    E.where_ . E.exists . E.from $ \examPartResult ->
+      E.where_ $ examPartResult E.^. ExamPartResultExamPart E.==. examPart E.^. ExamPartId
+    return ( examPart E.^. ExamPartId
+           , examPart E.^. ExamPartNumber
+           )
+  forM_ (join $ hoistMaybe oldPartsWithResults) $ \(E.Value epId, E.Value epNumber) ->
+    guardValidationM (MsgExamPartCannotBeDeletedDueToResults epNumber) . anyM (otoList efExamParts) $ \ExamPartForm{..} -> (== Just epId) <$> traverse decrypt epfId
+
+
   mSchool <- liftHandler . runDB . E.selectMaybe . E.from $ \(course `E.InnerJoin` school) -> do
     E.on $ course E.^. CourseSchool E.==. school E.^. SchoolId
     E.where_ $ course E.^. CourseId E.==. E.val cId
@@ -429,7 +465,7 @@ validateExam cId oldExam = do
   whenIsJust mSchool $ \(Entity _ School{..}) -> do
     whenIsJust schoolExamMinimumRegisterBeforeStart $ \minSep -> do
       let doValidation
-            | Just Exam{..} <- oldExam
+            | Just (Entity _ Exam{..}) <- oldExam
             , not . fromMaybe True $ (>=) <$> examStart <*> (addUTCTime minSep <$> examRegisterFrom)
             = warnValidation
             | otherwise
@@ -438,7 +474,7 @@ validateExam cId oldExam = do
         . fromMaybe True $ (>=) <$> efStart <*> (addUTCTime minSep <$> efRegisterFrom)
     whenIsJust schoolExamMinimumRegisterDuration $ \minDur -> do
       let doValidation
-            | Just Exam{..} <- oldExam
+            | Just (Entity _ Exam{..}) <- oldExam
             , not . fromMaybe True $ (>=) <$> examRegisterTo <*> (addUTCTime minDur <$> examRegisterFrom)
             = warnValidation
             | otherwise
@@ -447,7 +483,7 @@ validateExam cId oldExam = do
         . fromMaybe True $ (>=) <$> efRegisterTo <*> (addUTCTime minDur <$> efRegisterFrom)
     when schoolExamRequireModeForRegistration $ do
       let doValidation
-            | Just Exam{ examExamMode = ExamMode{..}, .. } <- oldExam
+            | Just (Entity _ Exam{ examExamMode = ExamMode{..}, .. }) <- oldExam
             , or [ is _Nothing examAids
                  , is _Nothing examOnline
                  , is _Nothing examSynchronicity
@@ -468,5 +504,5 @@ validateExam cId oldExam = do
 
     warnValidation MsgExamModeSchoolDiscouraged . not $ evalExamModeDNF schoolExamDiscouragedModes efExamMode
 
-  unless (has (_Just . _examStaff . _Nothing) oldExam) $
+  unless (has (_Just . _entityVal . _examStaff . _Nothing) oldExam) $
     guardValidation MsgExamStaffRequired $ isn't _Nothing efStaff
diff --git a/src/Handler/Exam/New.hs b/src/Handler/Exam/New.hs
index 3477273f0..43b7b287e 100644
--- a/src/Handler/Exam/New.hs
+++ b/src/Handler/Exam/New.hs
@@ -19,15 +19,13 @@ import qualified Data.Conduit.Combinators as C
 getCExamNewR, postCExamNewR :: TermId -> SchoolId -> CourseShorthand -> Handler Html
 getCExamNewR = postCExamNewR
 postCExamNewR tid ssh csh = do
-  (cid, template) <- runDB $ do
+  (newExamAct, (newExamWidget, newExamEnctype)) <- runDBJobs $ do
     cid <- getKeyBy404 $ TermSchoolCourseShort tid ssh csh
     template <- examTemplate cid
-    return (cid, template)
 
-  ((newExamResult, newExamWidget), newExamEnctype) <- runFormPost . validateForm (validateExam cid Nothing) $ examForm template
+    ((newExamResult, newExamWidget), newExamEnctype) <- runFormPost . validateForm (validateExam cid Nothing) $ examForm template
 
-  formResult newExamResult $ \ExamForm{..} -> do
-    insertRes <- runDBJobs $ do
+    newExamAct <- formResultMaybe newExamResult $ \ExamForm{..} -> do
       now <- liftIO getCurrentTime
 
       insertRes <- insertUnique Exam
@@ -95,12 +93,15 @@ postCExamNewR tid ssh csh = do
                 audit $ TransactionExamResultEdit examid courseParticipantUser
         runConduit $ selectSource [ CourseParticipantCourse ==. cid, CourseParticipantState ==. CourseParticipantInactive True ] [] .| C.mapM_ recordNoShow
 
-      return insertRes
-    case insertRes of
-      Nothing -> addMessageI Error $ MsgExamNameTaken efName
-      Just _  -> do
-        addMessageI Success $ MsgExamCreated efName
-        redirect $ CourseR tid ssh csh CExamListR
+      return . Just $ case insertRes of
+        Nothing -> addMessageI Error $ MsgExamNameTaken efName
+        Just _  -> do
+          addMessageI Success $ MsgExamCreated efName
+          redirect $ CourseR tid ssh csh CExamListR
+
+    return (newExamAct, (newExamWidget, newExamEnctype))
+
+  sequence_ newExamAct
 
   let heading = prependCourseTitle tid ssh csh MsgExamNew
 
diff --git a/src/Utils.hs b/src/Utils.hs
index 966f0e27c..b1c07a348 100644
--- a/src/Utils.hs
+++ b/src/Utils.hs
@@ -810,14 +810,14 @@ and2M, or2M :: Monad m => m Bool -> m Bool -> m Bool
 and2M ma mb = ifM ma mb (return False)
 or2M ma = ifM ma (return True)
 
-andM, orM :: (Foldable f, Monad m) => f (m Bool) -> m Bool
-andM = Fold.foldr and2M (return True)
-orM = Fold.foldr or2M (return False)
+andM, orM :: (MonoFoldable mono, Element mono ~ (m Bool), Monad m) => mono -> m Bool
+andM = ofoldl' and2M (return True)
+orM = ofoldl' or2M (return False)
 
 -- | Short-circuiting monady any
-allM, anyM :: (Functor f, Foldable f, Monad m) => f a -> (a -> m Bool) -> m Bool
-allM xs f = andM $ fmap f xs
-anyM xs f = orM $ fmap f xs
+allM, anyM :: (MonoFoldable mono, Monad m) => mono -> (Element mono -> m Bool) -> m Bool
+allM xs f = andM . fmap f $ otoList xs
+anyM xs f = orM . fmap f $ otoList xs
 
 ofoldr1M, ofoldl1M :: (MonoFoldable mono, Monad m) => (Element mono -> Element mono -> m (Element mono)) -> NonNull mono -> m (Element mono)
 ofoldr1M f (otoList -> x:xs) = foldrM f x xs

From 3ff2cf1fec1bf582fe1d5e1f6ee08dcc85d6bc00 Mon Sep 17 00:00:00 2001
From: Gregor Kleen <gregor.kleen@ifi.lmu.de>
Date: Tue, 27 Oct 2020 10:15:31 +0100
Subject: [PATCH 7/7] fix: work around conduit-bug releasing fh to early

---
 nixpkgs.nix        |  4 ++--
 src/Utils/Files.hs | 25 +++++++++++++++++++++++--
 2 files changed, 25 insertions(+), 4 deletions(-)

diff --git a/nixpkgs.nix b/nixpkgs.nix
index 375c84162..6a21dfbda 100644
--- a/nixpkgs.nix
+++ b/nixpkgs.nix
@@ -4,7 +4,7 @@
 import ((nixpkgs {}).fetchFromGitHub {
   owner = "NixOS";
   repo = "nixpkgs";
-  rev = "bc00ecedfa709f4fa91d445dd76ecd792cb2c728";
-  sha256 = "0plhwb04srr4b0h7w8qlqi207a19szz2wqz6r4gmic856jlkchaa";
+  rev = "a7a1447e5d40a9ad90983d33e151f5474eddeed9";
+  sha256 = "1zb8wgsq9grrsdcz81y08h45rj8i5r8ckjhg2cv1cqmam4dczcrf";
   fetchSubmodules = true;
 })
diff --git a/src/Utils/Files.hs b/src/Utils/Files.hs
index 3b334391c..f5251825e 100644
--- a/src/Utils/Files.hs
+++ b/src/Utils/Files.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE BangPatterns #-}
+
 module Utils.Files
   ( sinkFile, sinkFiles
   , sinkFile', sinkFiles'
@@ -35,6 +37,8 @@ import qualified Database.Esqueleto.Utils as E
 
 import Data.Conduit.Algorithms.FastCDC (fastCDC)
 
+import Control.Monad.Trans.Cont
+
 
 sinkFileDB :: (MonadCatch m, MonadHandler m, HandlerSite m ~ UniWorX, MonadUnliftIO m, BackendCompatible SqlBackend (YesodPersistBackend UniWorX), YesodPersist UniWorX)
            => Bool -- ^ Replace? Use only in serializable transaction
@@ -43,14 +47,16 @@ sinkFileDB :: (MonadCatch m, MonadHandler m, HandlerSite m ~ UniWorX, MonadUnlif
 sinkFileDB doReplace fileContentContent = do
   chunkingParams <- getsYesod $ view _appFileChunkingParams
 
-  let sinkChunk fileContentChunkContent = do
+  let sinkChunk !fileContentChunkContent = do
         fileChunkLockTime <- liftIO getCurrentTime
         fileChunkLockInstance <- getsYesod appInstanceID
 
         observeSunkChunk StorageDB $ olength fileContentChunkContent
 
         tellM $ Set.singleton <$> insert FileChunkLock{ fileChunkLockHash = fileContentChunkHash, .. }
+  
         existsChunk <- lift $ exists [FileContentChunkHash ==. fileContentChunkHash]
+      
         let setContentBased = updateWhere [FileContentChunkHash ==. fileContentChunkHash] [FileContentChunkContentBased =. fileContentChunkContentBased]
         if | existsChunk -> lift   setContentBased
            | otherwise   -> lift . handleIfSql isUniqueConstraintViolation (const setContentBased) $
@@ -144,7 +150,22 @@ sinkFile File{ fileContent = Nothing, .. } = return FileReference
   , fileReferenceModified = fileModified
   }
 sinkFile File{ fileContent = Just fileContentContent, .. } = do
-  (unsealConduitT -> fileContentContent', isEmpty) <- fileContentContent $$+ is _Nothing <$> C.peekE
+  chunk <- liftIO newEmptyTMVarIO
+  sourceAsync <- allocateLinkedAsync . runConduit $ fileContentContent .| C.mapM_ (atomically . putTMVar chunk)
+
+  isEmpty <- atomically $
+        False <$ readTMVar chunk
+    <|> True  <$ waitSTM sourceAsync
+
+  let fileContentContent' = evalContT . callCC $ \finishConsume -> forever $ do
+        inpChunk <- atomically $
+              Right <$> takeTMVar chunk
+          <|> Left  <$> waitCatchSTM sourceAsync
+
+        case inpChunk of
+          Right inpChunk'  -> lift $ yield inpChunk'
+          Left (Left exc)  -> throwM exc
+          Left (Right res) -> finishConsume res
 
   fileContentHash <- if
     | not isEmpty -> maybeT (sinkFileDB False fileContentContent') $ sinkFileMinio fileContentContent'