Course capacity now verified by route tag

Resolves #98

messages/de.msg

@@ -29,6 +29,9 @@ LectureStart: Beginn Vorlesungen
 
 Course: Kurs
 CourseNoCapacity: In diesem Kurs sind keine Plätze mehr frei.
+CourseRegisterOk: Sie wurden angemeldet
+CourseDeregisterOk: Sie wurden abgemeldet
+CourseSecretWrong: Falsches Kennwort
 CourseSecret: Zugangspasswort
 CourseNewOk        tid@TermId courseShortHand@Text: Kurs #{display tid}-#{courseShortHand} wurde erfolgreich erstellt.
 CourseEditOk       tid@TermId courseShortHand@Text: Kurs #{display tid}-#{courseShortHand} wurde erfolgreich geändert.

routes

@@ -15,6 +15,7 @@
 --    !corrector  -- corrector   for this sheet  (or the submission, if route is connected to a submission, or the course, if route is not connected to a sheet, or any course, if route is not connected to a course)
 --    !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
 --
 --    !materials  -- only if course allows all materials to be free (no meaning outside of courses)
 --    !time       -- access depends on time somehow
@@ -50,7 +51,7 @@
 !/course/new                CourseNewR        GET POST        !lecturer
 /course/#TermId/#Text       CourseR                           !lecturer:
   /                           CShowR          GET             !free
-  /register                   CRegisterR          POST        !time
+  /register                   CRegisterR          POST        !timeANDcapacity
   /edit                       CEditR          GET POST
   /subs                       CCorrectionsR   GET POST
   /ex                         SheetListR      GET             !registered !materials

src/Foundation.hs

@@ -342,6 +342,16 @@ knownTags = Map.fromList -- should not throw exceptions, i.e. no getBy404 or req
          $logErrorS "AccessControl" $ "'!registered' used on route that doesn't support it: " <> tshow r
          unauthorizedI MsgUnauthorized
    )
+  ,("capacity", APDB $ \route _ -> case route of
+       CourseR tid csh _ -> maybeT (unauthorizedI MsgCourseNoCapacity) $ do
+         Entity cid Course{..} <- MaybeT . getBy $ CourseTermShort tid csh
+         registered <- lift $ fromIntegral <$> count [ CourseParticipantCourse ==. cid ]
+         guard $ NTop courseCapacity > NTop (Just registered)
+         return Authorized
+       r -> do
+         $logErrorS "AccessControl" $ "'!capacity' used on route that doesn't support it: " <> tshow r
+         unauthorizedI MsgUnauthorized
+   )
   ,("materials", APDB $ \route _ -> case route of
       CourseR tid csh _ -> maybeT (unauthorizedI MsgUnfreeMaterials) $ do
         Entity _ Course{..} <- MaybeT . getBy $ CourseTermShort tid csh

src/Handler/Course.hs

@@ -139,12 +139,12 @@ postCRegisterR tid csh = do
     (FormSuccess codeOk)
       | registered -> do
           runDB $ deleteBy $ UniqueParticipant aid cid
-          addMessage "info" "Sie wurden abgemeldet."
+          addMessageI "info" MsgCourseDeregisterOk
       | codeOk -> do
           actTime <- liftIO $ getCurrentTime
           regOk <- runDB $ insertUnique $ CourseParticipant cid aid actTime
-          when (isJust regOk) $ addMessage "success" "Erfolgreich angemeldet!"
-      | otherwise -> addMessage "danger" "Falsches Kennwort!"
+          when (isJust regOk) $ addMessageI "success" MsgCourseRegisterOk
+      | otherwise -> addMessageI "danger" MsgCourseSecretWrong
     (_other) -> return () -- TODO check this!
   redirect $ CourseR tid csh CShowR
 

templates/course.hamlet

@@ -15,19 +15,20 @@
       <dd .deflist__dd>
         <div>
           <a href=#{link} target="_blank" rel="noopener" title="Website des Kurses">#{link}
-    <dt .deflist__dt>Teilnehmer
-    <dd .deflist__dd>
-      <div>
-        #{participants}
-        $maybe capacity <- courseCapacity course
-          \ von #{capacity}
-    $maybe regFrom <- courseRegisterFrom course
-      <dt .deflist__dt>Anmeldezeitraum
+    $if NTop (Just 0) < NTop (courseCapacity course)
+      <dt .deflist__dt>Teilnehmer
       <dd .deflist__dd>
         <div>
-          Ab #{formatTimeGerWD regFrom}
-          $maybe regTo   <- courseRegisterTo   course
-            \ bis #{formatTimeGerWD regTo}
+          #{participants}
+          $maybe capacity <- courseCapacity course
+            \ von #{capacity}
+      $maybe regFrom <- courseRegisterFrom course
+        <dt .deflist__dt>Anmeldezeitraum
+        <dd .deflist__dd>
+          <div>
+            Ab #{formatTimeGerWD regFrom}
+            $maybe regTo   <- courseRegisterTo   course
+              \ bis #{formatTimeGerWD regTo}
     $if registrationOpen
       <dt .deflist__dt>
       <dd .deflist__dd>