Course Capacity is verified now, in CRegister Handler that also checks secret

This commit is contained in:
SJost 2018-07-04 22:03:21 +02:00
parent d8ad0f67a5
commit 9fc50e8736
3 changed files with 11 additions and 3 deletions

View File

@ -26,6 +26,7 @@ TermPlaceholder: W/S + vierstellige Jahreszahl
LectureStart: Beginn Vorlesungen
Course: Kurs
CourseNoCapacity: In diesem Kurs sind keine Plätze mehr frei.
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.

View File

@ -127,7 +127,14 @@ postCRegisterR tid csh = do
addMessage "info" "Sie wurden abgemeldet."
| codeOk -> do
actTime <- liftIO $ getCurrentTime
regOk <- runDB $ insertUnique $ CourseParticipant cid aid actTime
regOk <- runDB $ do
reg <- count [CourseParticipantCourse ==. cid]
if NTop (Just reg) < NTop (courseCapacity course)
then -- current capacity has room
insertUnique $ CourseParticipant cid aid actTime
else do -- no space left
addMessageI "danger" MsgCourseNoCapacity
return Nothing
when (isJust regOk) $ addMessage "success" "Erfolgreich angemeldet!"
| otherwise -> addMessage "danger" "Falsches Kennwort!"
(_other) -> return () -- TODO check this!

View File

@ -39,8 +39,8 @@ getUsersR = do
cID <- encrypt $ entityKey $ fst3 u
let name = display $ userDisplayName $ entityVal $ fst3 u
[whamlet|<a href=@{AdminUserR cID}>#{name}|]
, headed "Admin for Schools" $ (\u -> text2widget $ intercalate ", " $ map (getSchoolname.userAdminSchool .entityVal) $ snd3 u)
, headed "Lecturer at Schools" $ (\u -> text2widget $ intercalate ", " $ map (getSchoolname.userLecturerSchool.entityVal) $ trd3 u)
, headed "Admin" $ (\u -> text2widget $ intercalate ", " $ map (getSchoolname.userAdminSchool .entityVal) $ snd3 u)
, headed "Lecturer" $ (\u -> text2widget $ intercalate ", " $ map (getSchoolname.userLecturerSchool.entityVal) $ trd3 u)
]
-- ++ map (\school -> headed (text2widget $ schoolName $ entityVal school) (\u -> "xx")) schools
defaultLayout $ do