fraport/fradrive-old
Archived
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fix(course-visibility): (more) correct visibility check for favourites

Browse Source
This commit is contained in:
Sarah Vaupel 2020-07-28 12:37:07 +02:00
parent d86fed7a32
commit 796a8066aa
2 changed files with 14 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
src/Foundation.hs
View File

@ -1984,7 +1984,7 @@ siteLayout' headingOverride widget = do
(favourites', maxFavouriteTerms, currentTheme) <- do (favourites', maxFavouriteTerms, currentTheme) <- do
muid <- maybeAuthPair 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.on $ E.just (course E.^. CourseId) E.==. courseFavourite E.?. CourseFavouriteCourse
E.&&. courseFavourite E.?. CourseFavouriteUser E.==. E.val (view _1 <$> muid) 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_ $ ((isFavourite E.||. isAssociated) E.&&. notBlacklist) E.||. isCurrent
E.where_ $ (E.isJust (course E.^. CourseVisibleFrom) return (course, reason, isAssociated)
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, 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 return ( favCourses
, maybe userDefaultMaxFavouriteTerms userMaxFavouriteTerms $ view _2 <$> muid , maybe userDefaultMaxFavouriteTerms userMaxFavouriteTerms $ view _2 <$> muid
@ -2040,7 +2042,7 @@ siteLayout' headingOverride widget = do
let favouriteTerms :: [TermIdentifier] let favouriteTerms :: [TermIdentifier]
favouriteTerms = take maxFavouriteTerms . Set.toDescList $ foldMap (\(Entity _ Course{..}, _, _) -> Set.singleton $ unTermKey courseTerm) favourites' 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 -> let courseRoute = CourseR courseTerm courseSchool courseShorthand CShowR
favouriteReason = fromMaybe FavouriteCurrent mFavourite favouriteReason = fromMaybe FavouriteCurrent mFavourite
in runMaybeT . guardOnM (unTermKey courseTerm `elem` favouriteTerms) . lift $ do in runMaybeT . guardOnM (unTermKey courseTerm `elem` favouriteTerms) . lift $ do
@ -2062,7 +2064,7 @@ siteLayout' headingOverride widget = do
$logDebugS "FavouriteQuickActions" $ tshow cK <> " Done." $logDebugS "FavouriteQuickActions" $ tshow cK <> " Done."
return items return items
$logDebugS "FavouriteQuickActions" $ tshow cK <> " returning " <> tshow (is _Just 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 nav'' <- mconcat <$> sequence
[ defaultLinks [ defaultLinks

4
templates/widgets/asidenav/asidenav.hamlet
View File

@ -21,13 +21,13 @@ $newline never
<h3 .asidenav__box-subtitle> <h3 .asidenav__box-subtitle>
_{favReason} _{favReason}
<ul .asidenav__list.list--iconless> <ul .asidenav__list.list--iconless>
$forall (course@Course{courseShorthand, courseName}, courseRoute, mPageActions, _, isLecturer) <- favouriteTermReason tid favReason $forall (course@Course{courseShorthand, courseName}, courseRoute, mPageActions, _, mayEditCourse) <- favouriteTermReason tid favReason
<li .asidenav__list-item :highlight courseRoute:.asidenav__list-item--active> <li .asidenav__list-item :highlight courseRoute:.asidenav__list-item--active>
<a .asidenav__link-wrapper href=@{courseRoute}> <a .asidenav__link-wrapper href=@{courseRoute}>
<div .asidenav__link-shorthand>#{courseShorthand} <div .asidenav__link-shorthand>#{courseShorthand}
<div .asidenav__link-label> <div .asidenav__link-label>
#{courseName} #{courseName}
$if not (courseIsVisible course) && isLecturer $if not (courseIsVisible course) && mayEditCourse
\ #{iconInvisible} \ #{iconInvisible}
<div .asidenav__nested-list-wrapper> <div .asidenav__nested-list-wrapper>
$maybe pageActions <- mPageActions $maybe pageActions <- mPageActions