fix(user-deregister): remove tutorial participation

src/Handler/Course/Register.hs

@@ -3,6 +3,7 @@ module Handler.Course.Register
   , CourseRegisterForm(..)
   , courseRegisterForm
   , getCRegisterR, postCRegisterR
+  , deregisterParticipant
   ) where
 
 import Import
@@ -202,16 +203,6 @@ postCRegisterR tid ssh csh = do
         audit $ TransactionCourseParticipantEdit cid uid
         insertUnique $ CourseParticipant cid uid cTime crfStudyFeatures Nothing
 
-      deleteApplications = do
-        appIds <- selectKeysList [ CourseApplicationAllocation ==. Nothing, CourseApplicationCourse ==. cid, CourseApplicationUser ==. uid ] []
-        forM_ appIds $ \appId -> do
-          deleteApplicationFiles appId
-          delete appId
-          audit $ TransactionCourseApplicationDeleted cid uid appId
-
-      deleteApplicationFiles appId = do
-        fs <- selectList [ CourseApplicationFileApplication ==. appId ] []
-        deleteCascadeWhere [ FileId <-. map (courseApplicationFileFile . entityVal) fs ]
     case courseRegisterButton of
       BtnCourseRegister -> runDB $ do
         regOk <- (\app reg -> (,) <$> app <*> reg) <$> mkApplication <*> mkRegistration
@@ -219,34 +210,14 @@ postCRegisterR tid ssh csh = do
           Nothing -> transactionUndo
           Just _  -> addMessageIconI Success IconEnrolTrue MsgCourseRegisterOk
       BtnCourseDeregister -> runDB $ do
-        deleteApplications
         part <- getBy $ UniqueParticipant uid cid
-        forM_ part $ \(Entity partId CourseParticipant{..}) -> do
-          delete $ partId
-          audit $ TransactionCourseParticipantDeleted cid uid
-
+        forM_ part $ \(Entity _partId CourseParticipant{..}) -> do
           when (is _Just courseParticipantAllocated) $ do
             now <- liftIO getCurrentTime
             insert_ $ AllocationDeregister courseParticipantUser (Just courseParticipantCourse) now Nothing
 
-        examRegistrations <- E.select . E.from $ \(examRegistration `E.InnerJoin` exam) -> do
-          E.on $ examRegistration E.^. ExamRegistrationExam E.==. exam E.^. ExamId
-          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
-          delete erId
-          audit $ TransactionExamDeregister examRegistrationExam uid
+        deregisterParticipant uid cid
 
-        examResults <- E.select . E.from $ \(examResult `E.InnerJoin` exam) -> do
-          E.on $ examResult E.^. ExamResultExam E.==. exam E.^. ExamId
-          E.where_ $ exam E.^. ExamCourse E.==. E.val cid
-               E.&&. examResult E.^. ExamResultUser E.==. E.val uid
-          return examResult
-        forM_ examResults $ \(Entity erId ExamResult{..}) -> do
-          delete erId
-          audit $ TransactionExamResultDeleted examResultExam uid
-  
         addMessageIconI Info IconEnrolFalse MsgCourseDeregisterOk
       BtnCourseApply -> runDB $ do
         regOk <- mkApplication
@@ -254,6 +225,53 @@ postCRegisterR tid ssh csh = do
           Nothing -> transactionUndo
           Just _  -> addMessageIconI Success IconApplyTrue MsgCourseApplyOk
       BtnCourseRetractApplication -> runDB $ do
-        deleteApplications
+        deleteApplications uid cid
         addMessageIconI Info IconApplyFalse MsgCourseRetractApplyOk
   redirect $ CourseR tid ssh csh CShowR
+
+deleteApplications :: UserId -> CourseId -> DB ()
+deleteApplications uid cid = do
+  appIds <- selectKeysList [ CourseApplicationAllocation ==. Nothing, CourseApplicationCourse ==. cid, CourseApplicationUser ==. uid ] []
+  forM_ appIds $ \appId -> do
+    deleteApplicationFiles appId
+    delete appId
+    audit $ TransactionCourseApplicationDeleted cid uid appId
+
+deleteApplicationFiles :: CourseApplicationId -> DB ()
+deleteApplicationFiles appId = do
+  fs <- selectList [ CourseApplicationFileApplication ==. appId ] []
+  deleteCascadeWhere [ FileId <-. map (courseApplicationFileFile . entityVal) fs ]
+
+deregisterParticipant :: UserId -> CourseId -> DB ()
+deregisterParticipant uid cid = do
+  deleteApplications uid cid
+  part <- getBy $ UniqueParticipant uid cid
+  forM_ part $ \(Entity partId CourseParticipant{..}) -> do
+    delete $ partId
+    audit $ TransactionCourseParticipantDeleted cid uid
+
+  examRegistrations <- E.select . E.from $ \(examRegistration `E.InnerJoin` exam) -> do
+    E.on $ examRegistration E.^. ExamRegistrationExam E.==. exam E.^. ExamId
+    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
+    delete erId
+    audit $ TransactionExamDeregister examRegistrationExam uid
+
+  examResults <- E.select . E.from $ \(examResult `E.InnerJoin` exam) -> do
+    E.on $ examResult E.^. ExamResultExam E.==. exam E.^. ExamId
+    E.where_ $ exam E.^. ExamCourse E.==. E.val cid
+         E.&&. examResult E.^. ExamResultUser E.==. E.val uid
+    return examResult
+  forM_ examResults $ \(Entity erId ExamResult{..}) -> do
+    delete erId
+    audit $ TransactionExamResultDeleted examResultExam uid
+
+  E.delete . E.from $ \tutorialParticipant -> do
+    let tutorialCourse = E.sub_select . E.from $ \tutorial -> do
+          E.where_ $ tutorial E.^. TutorialId E.==. tutorialParticipant E.^. TutorialParticipantTutorial
+          return $ tutorial E.^. TutorialCourse
+
+    E.where_ $ tutorialCourse E.==. E.val cid
+         E.&&. tutorialParticipant E.^. TutorialParticipantUser E.==. E.val uid

src/Handler/Course/User.hs

@@ -143,11 +143,10 @@ postCUserR tid ssh csh uCId = do
       | not mayRegister
         -> permissionDenied "User may not be registered"
     (BtnCourseDeregister, mbReason)
-      | Just (Entity pId CourseParticipant{..}) <- mRegistration
+      | Just (Entity _pId CourseParticipant{..}) <- mRegistration
         -> do
           runDB $ do
-            delete pId
-            audit $ TransactionCourseParticipantDeleted cid courseParticipantUser
+            deregisterParticipant courseParticipantUser courseParticipantCourse
 
             whenIsJust mbReason $ \reason -> do
               now <- liftIO getCurrentTime

src/Handler/Course/Users.hs

@@ -14,6 +14,8 @@ import Handler.Utils
 import qualified Database.Esqueleto.Utils as E
 import Database.Esqueleto.Utils.TH
 
+import Handler.Course.Register (deregisterParticipant)
+
 import Data.Function ((&))
 
 import qualified Data.Set as Set
@@ -481,9 +483,8 @@ postCUsersR tid ssh csh = do
     (CourseUserDeregisterData{..}, selectedUsers) -> do
         Sum nrDel <- fmap mconcat . runDB . forM (Set.toList selectedUsers) $ \uid -> fmap (maybe mempty Sum) . runMaybeT $ do
           now <- liftIO getCurrentTime
-          Entity reg CourseParticipant{..} <- MaybeT . getBy $ UniqueParticipant uid cid
-          lift $ delete reg
-          lift . audit $ TransactionCourseParticipantDeleted cid uid
+          Entity _ CourseParticipant{..} <- MaybeT . getBy $ UniqueParticipant uid cid
+          lift $ deregisterParticipant courseParticipantUser courseParticipantCourse
           case deregisterReason of
             Just reason
               | is _Just courseParticipantAllocated ->