From 16ad72d87638a195afbfbc390f23182dc705f7fd Mon Sep 17 00:00:00 2001
From: Sarah Vaupel <>
Date: Sat, 8 Aug 2020 12:38:20 +0200
Subject: [PATCH] feat(course-visibility): warn on deregister from invisible
 course

---
 messages/uniworx/de-de-formal.msg |  1 +
 messages/uniworx/en-eu.msg        |  1 +
 src/Handler/Course/Register.hs    | 17 ++++++++++++++++-
 3 files changed, 18 insertions(+), 1 deletion(-)

diff --git a/messages/uniworx/de-de-formal.msg b/messages/uniworx/de-de-formal.msg
index 497a2ca50..5032c1158 100644
--- a/messages/uniworx/de-de-formal.msg
+++ b/messages/uniworx/de-de-formal.msg
@@ -2376,6 +2376,7 @@ CourseDeregisterNoShow: „Nicht erschienen“ bei Abmeldung
 CourseDeregisterNoShowTip: Soll, wenn sich Teilnehmer selbstständig abmelden, für alle Prüfungen dieses Kurses „nicht erschienen“ als Prüfungsleistung eingetragen werden? Dies geschieht einmalig bei der Abmeldung (sofern nicht bereits eine Prüfungsleistung existiert) und automatisch beim Anlegen von neuen Prüfungen.
 CourseDeregistrationAllocationShouldLog: Selbstverschuldet
 CourseDeregistrationAllocationShouldLogTip: Falls der Platz des Studierenden, der abgemeldet wird, aus einer Zentralanmeldung stammt, ist vorgesehen einen permanenten Eintrag im System zu speichern, der den Studierenden u.U. bei zukünftigen Zentralanmeldungen benachteiligt. Als Kursverwalter haben Sie die Möglichkeit dies zu unterbinden, wenn der Studierende gute Gründe vorweisen kann, warum seine Abmeldung nicht selbstverschuldet ist.
+CourseDeregistrationFromInvisibleCourse: Dieser Kurs ist nur für angemeldete Teilnehmer und Bewerber sichtbar. Wenn Sie sich jetzt abmelden, können Sie danach nicht wieder auf den Kurs zugreifen!
 
 MailSubjectAllocationResults allocation@AllocationName: Plätze für Zentralanmeldung „#{allocation}“ wurden verteilt
 AllocationResultsLecturer: Im Rahmen der oben genannten Zentralanmeldung wurden Plätze zugewiesen, wie folgt:
diff --git a/messages/uniworx/en-eu.msg b/messages/uniworx/en-eu.msg
index 511b67fe1..2a8cee8a6 100644
--- a/messages/uniworx/en-eu.msg
+++ b/messages/uniworx/en-eu.msg
@@ -2376,6 +2376,7 @@ CourseDeregisterNoShow: Record “no show” when deregistering
 CourseDeregisterNoShowTip: Should “no show” be recorded as the exam achievement for all exams associated with this course automatically whenever a course participant deregisters themselves? This would be done once upon deregistration (if no other achievement exists for the given exam) and automatically whenever a new exam is created.
 CourseDeregistrationAllocationShouldLog: Self imposed
 CourseDeregistrationAllocationShouldLogTip: If the participant was enrolled in this course due to a central allocation, it is intended that a permanent record be made that might affect the student negatively in future central allocations. As a course administrator you have the right to prevent this if the participant can present good reasons why them leaving the course is not self imposed.
+CourseDeregistrationFromInvisibleCourse: This course is only visible to enrolled participants and applicants. If you deregister now, you will not be able to access the course again!
 
 MailSubjectAllocationResults allocation: Placements have been made for the central allocation “#{allocation}”
 AllocationResultsLecturer: In the course of the central allocations placements have been made as follows:
diff --git a/src/Handler/Course/Register.hs b/src/Handler/Course/Register.hs
index 180137e9d..55ee4d152 100644
--- a/src/Handler/Course/Register.hs
+++ b/src/Handler/Course/Register.hs
@@ -50,6 +50,9 @@ courseRegisterForm :: (MonadHandler m, HandlerSite m ~ UniWorX) => Entity Course
 -- ^ `CourseRegisterForm` for current user
 courseRegisterForm (Entity cid Course{..}) = liftHandler $ do
   muid <- maybeAuthId
+  ata <- getSessionActiveAuthTags
+  now <- liftIO getCurrentTime
+
   (registration, application) <- runDB $ do
     registration <- fmap join . for muid $ fmap (assertM . has $ _entityVal . _courseParticipantState . _CourseParticipantActive) . getBy . flip UniqueParticipant cid
     application <- fmap (listToMaybe =<<) . for muid $ \uid -> selectList [CourseApplicationCourse ==. cid, CourseApplicationUser ==. uid, CourseApplicationAllocation ==. Nothing] []
@@ -144,11 +147,23 @@ courseRegisterForm (Entity cid Course{..}) = liftHandler $ do
       | otherwise
         -> aFormToWForm $ fileUploadForm False (fslI . mkFs) courseApplicationsFiles
 
+    mayViewCourseAfterDeregistration <- liftHandler . runDB $ E.selectExists . E.from $ \course -> E.where_ $
+      course E.^. CourseId E.==. E.val cid
+      E.&&. ( isSchoolAdminLike muid ata (course E.^. CourseSchool)
+        E.||. mayEditCourse muid ata course
+        E.||. courseIsVisible now course Nothing
+        E.||. isCourseLecturer muid ata (course E.^. CourseId)
+        E.||. isCourseTutor muid ata (course E.^. CourseId)
+        E.||. isCourseCorrector muid ata (course E.^. CourseId)
+        )
+
     when (is _Just $ registration >>= courseParticipantAllocated . entityVal) $
       wformMessage =<< messageIconI Warning IconExamRegisterFalse MsgCourseDeregistrationAllocationLog
     when (is _Just (registration >>= courseParticipantAllocated . entityVal) && courseDeregisterNoShow) $
       wformMessage =<< messageIconI Warning IconEnrolFalse MsgCourseDeregistrationNoShow
-      
+    when (isRegistered && not mayViewCourseAfterDeregistration) $
+      wformMessage =<< messageIconI Warning IconEnrolFalse MsgCourseDeregistrationFromInvisibleCourse
+
     return $ CourseRegisterForm
       <$  secretRes
       <*> fieldRes