fix: have exam deregistration always delete stored grades

src/Handler/Course/Register.hs

@@ -9,6 +9,7 @@ module Handler.Course.Register
 import Import
 
 import Handler.Utils
+import Handler.Utils.Exam
 
 import Utils.Course
 
@@ -297,9 +298,8 @@ deregisterParticipant uid cid = do
     E.where_ $ exam E.^. ExamCourse E.==. E.val cid
          E.&&. examRegistration E.^. ExamRegistrationUser E.==. E.val uid
     return examRegistration
-  forM_ examRegistrations $ \(Entity erId ExamRegistration{..}) -> do
+  forM_ examRegistrations $ \(Entity _ ExamRegistration{..}) -> do
-    delete erId
+    deregisterExamUsers examRegistrationExam $ pure examRegistrationUser
-    audit $ TransactionExamDeregister examRegistrationExam uid
 
   E.delete . E.from $ \tutorialParticipant -> do
     let tutorialCourse = E.subSelectForeign tutorialParticipant TutorialParticipantTutorial (E.^. TutorialCourse)

src/Handler/Exam/Show.hs

@@ -124,6 +124,7 @@ getEShowR tid ssh csh examn = do
         , mayRegister' (entityKey <$> mOcc) = Just $ do
             (examRegisterForm, examRegisterEnctype) <- liftHandler . generateFormPost . buttonForm' $ bool [BtnExamRegister] [BtnExamDeregister] isRegistered
             [whamlet|
+              $newline never
               <p>
                 $if isRegistered
                   _{MsgExamRegistered}
@@ -147,11 +148,12 @@ getEShowR tid ssh csh examn = do
             }
         | is _Nothing mOcc
         , is _Nothing registered
-        = Just [whamlet|_{MsgExamLoginToRegister}|]
+        = Just $ i18n MsgExamLoginToRegister
         | is _Nothing mOcc
         , isRegistered <- is _Just $ join registered
         = Just
             [whamlet|
+              $newline never
               <p>
                 $if isRegistered
                   _{MsgExamRegistered}

src/Handler/Exam/Users.hs

@@ -36,7 +36,7 @@ import qualified Data.CaseInsensitive as CI
 
 import Numeric.Lens (integral)
 
-import Database.Persist.Sql (deleteWhereCount, updateWhereCount)
+import Database.Persist.Sql (updateWhereCount)
 
 import Control.Lens.Indexed ((<.), (.>))
 
@@ -840,13 +840,8 @@ postEUsersR tid ssh csh examn = do
                         ]
                       audit $ TransactionExamResultEdit eid examUserCsvActUser
                   ExamUserCsvDeregisterData{..} -> do
-                    ExamRegistration{examRegistrationUser} <- getJust examUserCsvActRegistration
+                    ExamRegistration{..} <- getJust examUserCsvActRegistration
-                    audit $ TransactionExamDeregister eid examRegistrationUser
+                    deregisterExamUsers examRegistrationExam $ pure examRegistrationUser
-                    delete examUserCsvActRegistration
-                    result <- getBy $ UniqueExamResult eid examRegistrationUser
-                    forM_ result $ \(Entity erId _) -> do
-                      delete erId
-                      audit $ TransactionExamResultDeleted eid examRegistrationUser
                   ExamUserCsvSetCourseNoteData{ examUserCsvActCourseNote = Nothing, .. } -> do
                     noteId <- getKeyBy $ UniqueCourseUserNote examUserCsvActUser examCourse
                     whenIsJust noteId $ \nid -> do
@@ -1051,10 +1046,9 @@ postEUsersR tid ssh csh examn = do
     (, exam, bonus) . over (_1 . _2) postprocess <$> dbTable examUsersDBTableValidator examUsersDBTable
 
   formResult registrationResult $ \case
-    (ExamUserDeregisterData, Map.keysSet -> selectedRegistrations) -> do
+    (ExamUserDeregisterData, Map.elems -> selectedRegistrations) -> do
-      nrDel <- runDB $ deleteWhereCount
+      nrDel <- runDB . setSerializable . deregisterExamUsersCount eId $ map (view $ resultUser . _entityKey) selectedRegistrations
-        [ ExamRegistrationId <-. Set.toList selectedRegistrations
+
-        ]
       addMessageI Success $ MsgExamUsersDeregistered nrDel
       redirect $ CExamR tid ssh csh examn EUsersR
     (ExamUserAssignOccurrenceData occId, Map.keysSet -> selectedRegistrations) -> do

src/Handler/Utils/Exam.hs

@@ -10,6 +10,7 @@ module Handler.Utils.Exam
   , eaocMinimizeRooms, eaocFinenessCost, eaocNudge, eaocNudgeSize
   , _eaocMinimizeRooms, _eaocFinenessCost, _eaocNudge, _eaocNudgeSize
   , examAutoOccurrence
+  , deregisterExamUsersCount, deregisterExamUsers
   ) where
 
 import Import
@@ -609,3 +610,34 @@ examAutoOccurrence (hash -> seed) rule ExamAutoOccurrenceConfig{..} occurrences
              in Set.map (appEndo $ foldMap Endo [ over l padSuff | l <- [_eaomrStart, _eaomrEnd, _eaomrSpecial]]) <$> res
           | otherwise
           = res
+
+
+deregisterExamUsersCount :: (MonadIO m, HandlerSite m ~ UniWorX, MonadHandler m, MonadCatch m) => ExamId -> [UserId] -> SqlPersistT m Int64
+deregisterExamUsersCount eId uids = do
+  partResults <- E.select . E.from $ \(examPart `E.InnerJoin` examPartResult) -> do
+    E.on $ examPart E.^. ExamPartId E.==. examPartResult E.^. ExamPartResultExamPart
+    E.where_ $ examPart E.^. ExamPartExam E.==. E.val eId
+         E.&&. examPartResult E.^. ExamPartResultUser `E.in_` E.valList uids
+    return examPartResult
+  forM_ partResults $ \(Entity resId ExamPartResult{..}) -> do
+    delete resId
+    audit $ TransactionExamPartResultDeleted examPartResultExamPart examPartResultUser
+
+  results <- selectList [ ExamResultExam ==. eId, ExamResultUser <-. uids ] []
+  forM_ results $ \(Entity resId ExamResult{..}) -> do
+    delete resId
+    audit $ TransactionExamResultDeleted examResultExam examResultUser
+
+  boni <- selectList [ ExamBonusExam ==. eId, ExamBonusUser <-. uids ] []
+  forM_ boni $ \(Entity bonusId ExamBonus{..}) -> do
+    delete bonusId
+    audit $ TransactionExamBonusDeleted examBonusExam examBonusUser
+
+  regs <- selectList [ ExamRegistrationExam ==. eId, ExamRegistrationUser <-. uids ] []
+  fmap (ala Sum foldMap) . forM regs $ \(Entity regId ExamRegistration{..}) -> do
+    delete regId
+    audit $ TransactionExamDeregister examRegistrationExam examRegistrationUser
+    return 1
+
+deregisterExamUsers :: (MonadIO m, HandlerSite m ~ UniWorX, MonadHandler m, MonadCatch m) => ExamId -> [UserId] -> SqlPersistT m ()
+deregisterExamUsers eId uids = void $ deregisterExamUsersCount eId uids

templates/exam-show.hamlet

@@ -87,8 +87,8 @@ $maybe desc <- examDescription
     $maybe registerWdgt <- registerWidget Nothing
       <dt .deflist__dt>
         _{MsgExamRegistration}
-        \ ^{isVisible False}
+      <dd .deflist__dd>
-      <dd .deflist__dd>^{registerWdgt}
+        ^{registerWdgt}
 
 $if showCloseWidget && is _Nothing examClosed
   <section>