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

feat(course-visibility): account for visibility on TShowR

Browse Source
This commit is contained in:
Sarah Vaupel 2020-07-29 15:31:02 +02:00
parent df7a784a9d
commit 0ff07a5fad
2 changed files with 9 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
src/Handler/Term.hs
View File

@ -5,7 +5,11 @@ module Handler.Term
) where ) where
import Import import Import
import Utils.Course (mayViewCourse)
import Handler.Utils import Handler.Utils
import qualified Data.Map as Map import qualified Data.Map as Map
import qualified Database.Esqueleto as E import qualified Database.Esqueleto as E
@ -62,11 +66,14 @@ validateTerm = do
getTermShowR :: Handler Html getTermShowR :: Handler Html
getTermShowR = do getTermShowR = do
muid <- maybeAuthId
now <- liftIO getCurrentTime
table <- runDB $ table <- runDB $
let termDBTable = DBTable{..} let termDBTable = DBTable{..}
where dbtSQLQuery term = return (term, courseCount) where dbtSQLQuery term = return (term, courseCount)
where courseCount = E.subSelectCount . E.from $ \course -> where courseCount = E.subSelectCount . E.from $ \course ->
E.where_ $ term E.^. TermId E.==. course E.^. CourseTerm E.where_ $ term E.^. TermId E.==. course E.^. CourseTerm
E.&&. mayViewCourse muid now course
dbtRowKey = (E.^. TermId) dbtRowKey = (E.^. TermId)
dbtProj = return . dbrOutput dbtProj = return . dbrOutput
dbtColonnade = widgetColonnade $ mconcat dbtColonnade = widgetColonnade $ mconcat

3
src/Utils/Course.hs
View File

@ -14,7 +14,8 @@ import qualified Database.Esqueleto as E
import qualified Database.Esqueleto.Utils 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) mayViewCourse :: Maybe UserId -> UTCTime -> E.SqlExpr (Entity Course) -> E.SqlExpr (E.Value Bool)