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,16 +210,46 @@ 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
+          when (is _Just courseParticipantAllocated) $ do
+            now <- liftIO getCurrentTime
+            insert_ $ AllocationDeregister courseParticipantUser (Just courseParticipantCourse) now Nothing
+
+        deregisterParticipant uid cid
+
+        addMessageIconI Info IconEnrolFalse MsgCourseDeregisterOk
+      BtnCourseApply -> runDB $ do
+        regOk <- mkApplication
+        case regOk of
+          Nothing -> transactionUndo
+          Just _  -> addMessageIconI Success IconApplyTrue MsgCourseApplyOk
+      BtnCourseRetractApplication -> runDB $ do
+        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
 
-          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
@@ -247,13 +268,10 @@ postCRegisterR tid ssh csh = do
     delete erId
     audit $ TransactionExamResultDeleted examResultExam uid
 
-        addMessageIconI Info IconEnrolFalse MsgCourseDeregisterOk
+  E.delete . E.from $ \tutorialParticipant -> do
-      BtnCourseApply -> runDB $ do
+    let tutorialCourse = E.sub_select . E.from $ \tutorial -> do
-        regOk <- mkApplication
+          E.where_ $ tutorial E.^. TutorialId E.==. tutorialParticipant E.^. TutorialParticipantTutorial
-        case regOk of
+          return $ tutorial E.^. TutorialCourse
-          Nothing -> transactionUndo
+
-          Just _  -> addMessageIconI Success IconApplyTrue MsgCourseApplyOk
+    E.where_ $ tutorialCourse E.==. E.val cid
-      BtnCourseRetractApplication -> runDB $ do
+         E.&&. tutorialParticipant E.^. TutorialParticipantUser E.==. E.val uid
-        deleteApplications
-        addMessageIconI Info IconApplyFalse MsgCourseRetractApplyOk
-  redirect $ CourseR tid ssh csh CShowR

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
+            deregisterParticipant courseParticipantUser courseParticipantCourse
-            audit $ TransactionCourseParticipantDeleted cid courseParticipantUser
 
             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
+          Entity _ CourseParticipant{..} <- MaybeT . getBy $ UniqueParticipant uid cid
-          lift $ delete reg
+          lift $ deregisterParticipant courseParticipantUser courseParticipantCourse
-          lift . audit $ TransactionCourseParticipantDeleted cid uid
           case deregisterReason of
             Just reason
               | is _Just courseParticipantAllocated ->