From d60ef89bcaf79bcd1565f9948cefa12b91ee29b6 Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Sun, 8 Jul 2018 10:31:41 +0200 Subject: [PATCH 1/9] Revert "Course Capacity is verified now, in CRegister Handler that also checks secret" This reverts commit 9fc50e8736f9db317fb99a2b325ca3707f6c0a69. --- src/Handler/Course.hs | 9 +-------- 1 file changed, 1 insertion(+), 8 deletions(-) diff --git a/src/Handler/Course.hs b/src/Handler/Course.hs index b9c3446e5..4fb1e98b5 100644 --- a/src/Handler/Course.hs +++ b/src/Handler/Course.hs @@ -142,14 +142,7 @@ postCRegisterR tid csh = do addMessage "info" "Sie wurden abgemeldet." | codeOk -> do actTime <- liftIO $ getCurrentTime - regOk <- runDB $ do - reg <- count [CourseParticipantCourse ==. cid] - if NTop (Just $ fromIntegral reg) < NTop (courseCapacity course) - then -- current capacity has room - insertUnique $ CourseParticipant cid aid actTime - else do -- no space left - addMessageI "danger" MsgCourseNoCapacity - return Nothing + regOk <- runDB $ insertUnique $ CourseParticipant cid aid actTime when (isJust regOk) $ addMessage "success" "Erfolgreich angemeldet!" | otherwise -> addMessage "danger" "Falsches Kennwort!" (_other) -> return () -- TODO check this! From 7da8d89a5cdd195ef6487ef218127a8fc277d82f Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Sun, 8 Jul 2018 10:44:09 +0200 Subject: [PATCH 2/9] 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 @@
#{link} -
Teilnehmer -
-
- #{participants} - $maybe capacity <- courseCapacity course - \ von #{capacity} - $maybe regFrom <- courseRegisterFrom course -
Anmeldezeitraum + $if NTop (Just 0) < NTop (courseCapacity course) +
Teilnehmer
- Ab #{formatTimeGerWD regFrom} - $maybe regTo <- courseRegisterTo course - \ bis #{formatTimeGerWD regTo} + #{participants} + $maybe capacity <- courseCapacity course + \ von #{capacity} + $maybe regFrom <- courseRegisterFrom course +
Anmeldezeitraum +
+
+ Ab #{formatTimeGerWD regFrom} + $maybe regTo <- courseRegisterTo course + \ bis #{formatTimeGerWD regTo} $if registrationOpen
From d0fcf2e9e36880d84b176b7a238e4e6d1e4b02f5 Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Sun, 8 Jul 2018 13:52:25 +0200 Subject: [PATCH 3/9] Allow customizing behaviour of dbTable when empty Resolves #104 --- messages/de.msg | 5 ++++- src/Handler/Corrections.hs | 2 +- src/Handler/Course.hs | 2 +- src/Handler/Home.hs | 4 ++-- src/Handler/Sheet.hs | 2 +- src/Handler/Submission.hs | 2 +- src/Handler/Term.hs | 2 +- src/Handler/Utils/Table/Pagination.hs | 30 ++++++++++++++++++++++----- templates/table/colonnade.hamlet | 6 +++--- templates/table/layout.hamlet | 21 +++++++++++-------- 10 files changed, 51 insertions(+), 25 deletions(-) diff --git a/messages/de.msg b/messages/de.msg index cb01caae3..568eaf109 100644 --- a/messages/de.msg +++ b/messages/de.msg @@ -187,4 +187,7 @@ RatingFilesUpdated: Korrigierte Dateien überschrieben CourseMembers: Teilnehmer CourseMembersCount num@Int64: #{display num} -CourseMembersCountLimited num@Int64 max@Int64: #{display num}/#{display max} \ No newline at end of file +CourseMembersCountLimited num@Int64 max@Int64: #{display num}/#{display max} + +NoTableContent: Kein Tabelleninhalt +NoUpcomingSheetDeadlines: Keine anstehenden Übungsblätter \ No newline at end of file diff --git a/src/Handler/Corrections.hs b/src/Handler/Corrections.hs index 360ceba5a..0fc43773d 100644 --- a/src/Handler/Corrections.hs +++ b/src/Handler/Corrections.hs @@ -170,7 +170,7 @@ makeCorrectionsTable whereClause colChoices psValidator = do E.||. (if Nothing `Set.member` emails then E.isNothing (corrector E.?. UserEmail) else E.val False) ) ] - , dbtAttrs = tableDefault + , dbtStyle = def , dbtIdent = "corrections" :: Text } diff --git a/src/Handler/Course.hs b/src/Handler/Course.hs index 93b5b0874..d4e2c529b 100644 --- a/src/Handler/Course.hs +++ b/src/Handler/Course.hs @@ -85,7 +85,7 @@ getTermCourseListR tid = do ) ] , dbtFilter = mempty - , dbtAttrs = tableDefault + , dbtStyle = def , dbtIdent = "courses" :: Text } diff --git a/src/Handler/Home.hs b/src/Handler/Home.hs index dfb28c82b..b5e0b7412 100644 --- a/src/Handler/Home.hs +++ b/src/Handler/Home.hs @@ -99,7 +99,7 @@ homeAnonymous = do | otherwise -> course E.^. CourseTerm `E.in_` E.valList (Set.toList tids) ) ] -} - , dbtAttrs = tableDefault + , dbtStyle = def , dbtIdent = "upcomingdeadlines" :: Text } let features = $(widgetFile "featureList") @@ -188,7 +188,7 @@ homeUser uid = do | otherwise -> course E.^. CourseTerm `E.in_` E.valList (Set.toList tids) ) ] -} - , dbtAttrs = tableDefault + , dbtStyle = def { dbsEmptyStyle = DBESNoHeading, dbsEmptyMessage = MsgNoUpcomingSheetDeadlines } , dbtIdent = "upcomingdeadlines" :: Text } defaultLayout $ do diff --git a/src/Handler/Sheet.hs b/src/Handler/Sheet.hs index d9207f0ce..1ddbd051c 100644 --- a/src/Handler/Sheet.hs +++ b/src/Handler/Sheet.hs @@ -227,7 +227,7 @@ getSShowR tid csh shn = do fileTable <- dbTable def $ DBTable { dbtSQLQuery = fileData , dbtColonnade = colonnadeFiles - , dbtAttrs = tableDefault + , dbtStyle = def , dbtFilter = Map.empty , dbtIdent = "files" :: Text -- TODO: Add column for and visibility date diff --git a/src/Handler/Submission.hs b/src/Handler/Submission.hs index aa574d5d6..5ff6058a1 100644 --- a/src/Handler/Submission.hs +++ b/src/Handler/Submission.hs @@ -288,7 +288,7 @@ submissionHelper tid csh shn (SubmissionMode mcid) = do smid2ArchiveTable (smid,cid) = DBTable { dbtSQLQuery = submissionFiles smid , dbtColonnade = colonnadeFiles cid - , dbtAttrs = tableDefault + , dbtStyle = def , dbtIdent = "files" :: Text , dbtSorting = [ ( "path" , SortColumn $ \((sf1 `E.InnerJoin` f1) `E.FullOuterJoin` (sf2 `E.InnerJoin` f2)) -> E.coalesce [f1 E.?. FileTitle, f2 E.?. FileTitle] diff --git a/src/Handler/Term.hs b/src/Handler/Term.hs index b3a6a3f5a..22782165f 100644 --- a/src/Handler/Term.hs +++ b/src/Handler/Term.hs @@ -99,7 +99,7 @@ getTermShowR = do E.&&. course E.^. CourseShorthand `E.in_` E.valList cshs ) ] - , dbtAttrs = tableDefault + , dbtStyle = def , dbtIdent = "terms" :: Text } defaultLayout $ do diff --git a/src/Handler/Utils/Table/Pagination.hs b/src/Handler/Utils/Table/Pagination.hs index e7d47b10e..5ea5b5e0a 100644 --- a/src/Handler/Utils/Table/Pagination.hs +++ b/src/Handler/Utils/Table/Pagination.hs @@ -21,6 +21,7 @@ module Handler.Utils.Table.Pagination ( SortColumn(..), SortDirection(..) , FilterColumn(..), IsFilterColumn , DBRow(..), DBOutput + , DBStyle(..), DBEmptyStyle(..) , DBTable(..), IsDBTable(..) , PaginationSettings(..), PaginationInput(..), piIsUnset , PSValidator(..) @@ -128,6 +129,25 @@ instance DBOutput (DBRow r) r where instance DBOutput (DBRow r) (Int64, r) where dbProj = (,) <$> dbrIndex <*> dbrOutput +data DBEmptyStyle = DBESNoHeading | DBESHeading + deriving (Enum, Bounded, Ord, Eq, Show, Read) + +instance Default DBEmptyStyle where + def = DBESHeading + +data DBStyle = DBStyle + { dbsEmptyStyle :: DBEmptyStyle + , dbsEmptyMessage :: UniWorXMessage + , dbsAttrs :: [(Text, Text)] + } + +instance Default DBStyle where + def = DBStyle + { dbsEmptyStyle = def + , dbsEmptyMessage = MsgNoTableContent + , dbsAttrs = [ ("class", "table table-striped table-hover table-sortable") ] + } + data DBTable m x = forall a r r' h i t. ( ToSortable h, Functor h , E.SqlSelect a r, DBOutput (DBRow r) r' @@ -138,7 +158,7 @@ data DBTable m x = forall a r r' h i t. , dbtColonnade :: Colonnade h r' (DBCell m x) , dbtSorting :: Map (CI Text) (SortColumn t) , dbtFilter :: Map (CI Text) (FilterColumn t) - , dbtAttrs :: Attribute -- FIXME: currently unused + , dbtStyle :: DBStyle , dbtIdent :: i } @@ -285,7 +305,7 @@ instance IsDBTable m a => IsString (DBCell m a) where dbTable :: forall m x. IsDBTable m x => PSValidator m x -> DBTable m x -> Handler (DBResult m x) -dbTable PSValidator{..} dbtable@(DBTable{ dbtIdent = (toPathPiece -> dbtIdent), dbtColonnade = (lmap dbProj -> dbtColonnade), .. }) = do +dbTable PSValidator{..} dbtable@(DBTable{ dbtIdent = (toPathPiece -> dbtIdent), dbtColonnade = (lmap dbProj -> dbtColonnade), dbtStyle = DBStyle{..}, .. }) = do let sortingOptions = mkOptionList [ Option t' (t, d) t' @@ -297,9 +317,9 @@ dbTable PSValidator{..} dbtable@(DBTable{ dbtIdent = (toPathPiece -> dbtIdent), wIdent n | not $ null dbtIdent = dbtIdent <> "-" <> n | otherwise = n - dbtAttrs' - | not $ null dbtIdent = Html5.id (fromString $ unpack dbtIdent) <> dbtAttrs - | otherwise = dbtAttrs + dbsAttrs' + | not $ null dbtIdent = ("id", dbtIdent) : dbsAttrs + | otherwise = dbsAttrs multiTextField = Field { fieldParse = \ts _ -> return . Right $ Just ts , fieldView = undefined diff --git a/templates/table/colonnade.hamlet b/templates/table/colonnade.hamlet index 147cdebc7..f56dfaa14 100644 --- a/templates/table/colonnade.hamlet +++ b/templates/table/colonnade.hamlet @@ -1,5 +1,5 @@ $newline never - +
$maybe wHeaders' <- wHeaders @@ -8,10 +8,10 @@ $newline never ^{widget} $nothing - $if null wRows + $if null wRows && (dbsEmptyStyle == DBESHeading) diff --git a/templates/table/layout.hamlet b/templates/table/layout.hamlet index a6578422c..46e1da27a 100644 --- a/templates/table/layout.hamlet +++ b/templates/table/layout.hamlet @@ -1,10 +1,13 @@ $newline never -
-
- ^{table} - $if pageCount > 1 -
- Kein Inhalt. + _{dbsEmptyMessage} $else $forall row <- wRows