From 796a8066aaac4d4c2789b65563672fff0d07dfe5 Mon Sep 17 00:00:00 2001 From: Sarah Vaupel <> Date: Tue, 28 Jul 2020 12:37:07 +0200 Subject: [PATCH] fix(course-visibility): (more) correct visibility check for favourites --- src/Foundation.hs | 22 ++++++++++++---------- templates/widgets/asidenav/asidenav.hamlet | 4 ++-- 2 files changed, 14 insertions(+), 12 deletions(-) diff --git a/src/Foundation.hs b/src/Foundation.hs index 30498f0f3..fbdc03690 100644 --- a/src/Foundation.hs +++ b/src/Foundation.hs @@ -1984,7 +1984,7 @@ siteLayout' headingOverride widget = do (favourites', maxFavouriteTerms, currentTheme) <- do muid <- maybeAuthPair - favCourses <- runDB . E.select . E.from $ \(course `E.LeftOuterJoin` courseFavourite) -> do + favCourses'' <- runDB . E.select . E.from $ \(course `E.LeftOuterJoin` courseFavourite) -> do E.on $ E.just (course E.^. CourseId) E.==. courseFavourite E.?. CourseFavouriteCourse E.&&. courseFavourite E.?. CourseFavouriteUser E.==. E.val (view _1 <$> muid) @@ -2023,14 +2023,16 @@ siteLayout' headingOverride widget = do E.where_ $ ((isFavourite E.||. isAssociated) E.&&. notBlacklist) E.||. isCurrent - E.where_ $ (E.isJust (course E.^. CourseVisibleFrom) - E.&&. course E.^. CourseVisibleFrom E.<=. E.val (Just now) - E.&&. (E.isNothing (course E.^. CourseVisibleTo) - E.||. E.val (Just now) E.<=. course E.^. CourseVisibleTo - ) - ) E.||. isAssociated + return (course, reason, isAssociated) - return (course, reason, isLecturer) + favCourses' <- forM favCourses'' $ \(course@(Entity _ Course{..}), reason, isAssociated) -> do + mayEditCourse <- hasWriteAccessTo $ CourseR courseTerm courseSchool courseShorthand CEditR + return (course, reason, isAssociated, mayEditCourse) + + -- remove invisible courses + let favCourses = favCourses' + & filter (\(Entity _ Course{..}, _, E.Value isAssociated, mayEditCourse) -> mayEditCourse || isAssociated || NTop courseVisibleFrom <= NTop (Just now) && NTop (Just now) <= NTop courseVisibleTo) + & map (\(course, reason, _, mayEditCourse) -> (course, reason, mayEditCourse)) return ( favCourses , maybe userDefaultMaxFavouriteTerms userMaxFavouriteTerms $ view _2 <$> muid @@ -2040,7 +2042,7 @@ siteLayout' headingOverride widget = do let favouriteTerms :: [TermIdentifier] favouriteTerms = take maxFavouriteTerms . Set.toDescList $ foldMap (\(Entity _ Course{..}, _, _) -> Set.singleton $ unTermKey courseTerm) favourites' - favourites <- fmap catMaybes . forM favourites' $ \(Entity cId c@Course{..}, E.Value mFavourite, E.Value isLecturer) + favourites <- fmap catMaybes . forM favourites' $ \(Entity cId c@Course{..}, E.Value mFavourite, mayEditCourse) -> let courseRoute = CourseR courseTerm courseSchool courseShorthand CShowR favouriteReason = fromMaybe FavouriteCurrent mFavourite in runMaybeT . guardOnM (unTermKey courseTerm `elem` favouriteTerms) . lift $ do @@ -2062,7 +2064,7 @@ siteLayout' headingOverride widget = do $logDebugS "FavouriteQuickActions" $ tshow cK <> " Done." return items $logDebugS "FavouriteQuickActions" $ tshow cK <> " returning " <> tshow (is _Just items) - return (c, courseRoute, items, favouriteReason, isLecturer) + return (c, courseRoute, items, favouriteReason, mayEditCourse) nav'' <- mconcat <$> sequence [ defaultLinks diff --git a/templates/widgets/asidenav/asidenav.hamlet b/templates/widgets/asidenav/asidenav.hamlet index d765c5b66..7ebd97cdc 100644 --- a/templates/widgets/asidenav/asidenav.hamlet +++ b/templates/widgets/asidenav/asidenav.hamlet @@ -21,13 +21,13 @@ $newline never

_{favReason}