From 7da8d89a5cdd195ef6487ef218127a8fc277d82f Mon Sep 17 00:00:00 2001
From: Gregor Kleen <gkleen@yggdrasil.li>
Date: Sun, 8 Jul 2018 10:44:09 +0200
Subject: [PATCH] Course capacity now verified by route tag

Resolves #98
---
 messages/de.msg         |  3 +++
 routes                  |  3 ++-
 src/Foundation.hs       | 10 ++++++++++
 src/Handler/Course.hs   |  6 +++---
 templates/course.hamlet | 23 ++++++++++++-----------
 5 files changed, 30 insertions(+), 15 deletions(-)

diff --git a/messages/de.msg b/messages/de.msg
index 1d542a5ff..cb01caae3 100644
--- a/messages/de.msg
+++ b/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.
diff --git a/routes b/routes
index 74b845e0c..48cc4578b 100644
--- a/routes
+++ b/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
diff --git a/src/Foundation.hs b/src/Foundation.hs
index 1544e03cb..8f56b2117 100644
--- a/src/Foundation.hs
+++ b/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
diff --git a/src/Handler/Course.hs b/src/Handler/Course.hs
index 4fb1e98b5..93b5b0874 100644
--- a/src/Handler/Course.hs
+++ b/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
 
diff --git a/templates/course.hamlet b/templates/course.hamlet
index 6d929ee3d..2803505f8 100644
--- a/templates/course.hamlet
+++ b/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>