AuthTag Empty implemented.

messages/uniworx/de.msg

@@ -38,6 +38,7 @@ CourseShort: Kürzel
 CourseCapacity: Kapazität
 CourseCapacityTip: Falls angegeben wird die Anzahl an Kursanmeldungen, die zugelassen werden, beschränkt
 CourseNoCapacity: In diesem Kurs sind keine Plätze mehr frei.
+CourseNotEmpty: In diesem Kurs sind momentan Teilnehmer angemeldet.
 CourseRegisterOk: Sie wurden angemeldet
 CourseDeregisterOk: Sie wurden abgemeldet
 CourseSecretWrong: Falsches Kennwort
@@ -543,6 +544,7 @@ AuthTagCorrector: Nutzer ist Korrektor
 AuthTagTime: Zeitliche Einschränkungen sind erfüllt
 AuthTagRegistered: Nutzer ist Kursteilnehmer
 AuthTagCapacity: Kapazität ist ausreichend
+AuthTagEmpty: Kurs hat keine Teilnehmer
 AuthTagMaterials: Kursmaterialien sind freigegeben
 AuthTagOwner: Nutzer ist Besitzer
 AuthTagRated: Korrektur ist bewertet

routes

@@ -16,6 +16,7 @@
 --    !registered  -- participant for this course (no effect outside of courses)
 --    !owner       -- part of the group of owners of this submission
 --    !capacity    -- course this route is associated with has at least one unit of participant capacity
+--    !empty       -- course this route is associated with has no participants whatsoever
 --
 --    !materials   -- only if course allows all materials to be free (no meaning outside of courses)
 --    !time        -- access depends on time somehow

src/Foundation.hs

@@ -481,6 +481,14 @@ tagAccessPredicate AuthCapacity = APDB $ \route _ -> case route of
     guard $ NTop courseCapacity > NTop (Just registered)
     return Authorized
   r -> $unsupportedAuthPredicate "capacity" r
+tagAccessPredicate AuthEmpty = APDB $ \route _ -> case route of
+  CourseR tid ssh csh _ -> maybeT (unauthorizedI MsgCourseNotEmpty) $ do
+    -- Entity cid Course{..} <- MaybeT . getBy $ TermSchoolCourseShort tid ssh csh
+    cid <- MaybeT . getKeyBy $ TermSchoolCourseShort tid ssh csh
+    registered <- lift $ fromIntegral <$> count [ CourseParticipantCourse ==. cid ]
+    guard $ registered <= 0
+    return Authorized
+  r -> $unsupportedAuthPredicate "empty" r
 tagAccessPredicate AuthMaterials = APDB $ \route _ -> case route of
   CourseR tid ssh csh _ -> maybeT (unauthorizedI MsgUnfreeMaterials) $ do
     Entity _ Course{..} <- MaybeT . getBy $ TermSchoolCourseShort tid ssh csh

src/Model/Types.hs

@@ -680,6 +680,7 @@ data AuthTag
   | AuthTime
   | AuthRegistered
   | AuthCapacity
+  | AuthEmpty
   | AuthMaterials
   | AuthOwner
   | AuthRated