diff --git a/src/Handler/Term.hs b/src/Handler/Term.hs index 94ae7ee53..44f730cbf 100644 --- a/src/Handler/Term.hs +++ b/src/Handler/Term.hs @@ -5,7 +5,11 @@ module Handler.Term ) where import Import + +import Utils.Course (mayViewCourse) + import Handler.Utils + import qualified Data.Map as Map import qualified Database.Esqueleto as E @@ -62,11 +66,14 @@ validateTerm = do getTermShowR :: Handler Html getTermShowR = do + muid <- maybeAuthId + now <- liftIO getCurrentTime table <- runDB $ let termDBTable = DBTable{..} where dbtSQLQuery term = return (term, courseCount) where courseCount = E.subSelectCount . E.from $ \course -> E.where_ $ term E.^. TermId E.==. course E.^. CourseTerm + E.&&. mayViewCourse muid now course dbtRowKey = (E.^. TermId) dbtProj = return . dbrOutput dbtColonnade = widgetColonnade $ mconcat diff --git a/src/Utils/Course.hs b/src/Utils/Course.hs index c85e5f83d..c2f012d1e 100644 --- a/src/Utils/Course.hs +++ b/src/Utils/Course.hs @@ -14,7 +14,8 @@ import qualified Database.Esqueleto as E import qualified Database.Esqueleto.Utils as E --- TODO switch from E.SqlExpr (Entity Course) to CourseId +-- TODO switch from E.SqlExpr (Entity Course) to CourseId wherever possible +-- TODO also check auth predicated everywhere mayViewCourse :: Maybe UserId -> UTCTime -> E.SqlExpr (Entity Course) -> E.SqlExpr (E.Value Bool)