96 lines
5.1 KiB
Haskell
96 lines
5.1 KiB
Haskell
module Utils.Course
|
|
( mayViewCourse, mayViewCourse', mayEditCourse, mayEditCourse'
|
|
, isCourseLecturer, isCourseTutor, isCourseCorrector, isCourseParticipant, isCourseAssociated
|
|
, courseIsVisible, courseIsVisible'
|
|
, numCourseParticipants
|
|
) where
|
|
|
|
import Import.NoFoundation
|
|
|
|
import qualified Database.Esqueleto as E
|
|
import qualified Database.Esqueleto.Utils as E
|
|
|
|
|
|
mayViewCourse :: Maybe UserId -> AuthTagActive -> UTCTime -> Entity Course -> E.SqlExpr (E.Value Bool)
|
|
mayViewCourse muid ata now c@(Entity cid course) =
|
|
mayEditCourse muid ata c
|
|
E.||. isCourseAssociated muid ata (E.val cid)
|
|
E.||. E.val (courseIsVisible' now course)
|
|
|
|
mayViewCourse' :: Maybe UserId -> AuthTagActive -> UTCTime -> E.SqlExpr (Entity Course) -> E.SqlExpr (E.Value Bool)
|
|
mayViewCourse' muid ata now course =
|
|
mayEditCourse' muid ata course
|
|
E.||. isCourseAssociated muid ata (course E.^. CourseId)
|
|
E.||. courseIsVisible now course
|
|
|
|
mayEditCourse :: Maybe UserId -> AuthTagActive -> Entity Course -> E.SqlExpr (E.Value Bool)
|
|
mayEditCourse muid ata@AuthTagActive{..} (Entity cid Course{..}) = (E.exists . E.from $ \(user `E.InnerJoin` userFunction) -> do
|
|
E.on $ user E.^. UserId E.==. userFunction E.^. UserFunctionUser
|
|
E.where_ $ E.just (user E.^. UserId) E.==. E.val muid
|
|
E.&&. userFunction E.^. UserFunctionFunction E.==. E.val SchoolAdmin
|
|
E.&&. userFunction E.^. UserFunctionSchool E.==. E.val courseSchool
|
|
E.&&. E.val (authTagIsActive AuthAdmin)
|
|
) E.||. isCourseLecturer muid ata (E.val cid)
|
|
|
|
mayEditCourse' :: Maybe UserId -> AuthTagActive -> E.SqlExpr (Entity Course) -> E.SqlExpr (E.Value Bool)
|
|
mayEditCourse' muid ata@AuthTagActive{..} course = (E.exists . E.from $ \(user `E.InnerJoin` userFunction) -> do
|
|
E.on $ user E.^. UserId E.==. userFunction E.^. UserFunctionUser
|
|
E.where_ $ E.just (user E.^. UserId) E.==. E.val muid
|
|
E.&&. userFunction E.^. UserFunctionFunction E.==. E.val SchoolAdmin
|
|
E.&&. userFunction E.^. UserFunctionSchool E.==. course E.^. CourseSchool
|
|
E.&&. E.val (authTagIsActive AuthAdmin)
|
|
) E.||. isCourseLecturer muid ata (course E.^. CourseId)
|
|
|
|
isCourseLecturer :: Maybe UserId -> AuthTagActive -> E.SqlExpr (E.Value CourseId) -> E.SqlExpr (E.Value Bool)
|
|
isCourseLecturer muid AuthTagActive{..} cid = E.exists . E.from $ \(user `E.InnerJoin` lecturer) -> do
|
|
E.on $ user E.^. UserId E.==. lecturer E.^. LecturerUser
|
|
E.where_ $ E.just (user E.^. UserId) E.==. E.val muid
|
|
E.&&. lecturer E.^. LecturerCourse E.==. cid
|
|
E.&&. E.val (authTagIsActive AuthLecturer)
|
|
|
|
isCourseTutor :: Maybe UserId -> AuthTagActive -> E.SqlExpr (E.Value CourseId) -> E.SqlExpr (E.Value Bool)
|
|
isCourseTutor muid AuthTagActive{..} cid = E.exists . E.from $ \(tutor `E.InnerJoin` tutorial) -> do
|
|
E.on $ tutor E.^. TutorTutorial E.==. tutorial E.^. TutorialId
|
|
E.where_ $ E.just (tutor E.^. TutorUser) E.==. E.val muid
|
|
E.&&. tutorial E.^. TutorialCourse E.==. cid
|
|
E.&&. E.val (authTagIsActive AuthTutor)
|
|
|
|
isCourseCorrector :: Maybe UserId -> AuthTagActive -> E.SqlExpr (E.Value CourseId) -> E.SqlExpr (E.Value Bool)
|
|
isCourseCorrector muid AuthTagActive{..} cid = E.exists . E.from $ \(sheetCorrector `E.InnerJoin` sheet) -> do
|
|
E.on $ sheetCorrector E.^. SheetCorrectorSheet E.==. sheet E.^. SheetId
|
|
E.where_ $ E.just (sheetCorrector E.^. SheetCorrectorUser) E.==. E.val muid
|
|
E.&&. sheet E.^. SheetCourse E.==. cid
|
|
E.&&. E.val (authTagIsActive AuthCorrector)
|
|
|
|
isCourseParticipant :: Maybe UserId -> AuthTagActive -> E.SqlExpr (E.Value CourseId) -> E.SqlExpr (E.Value Bool)
|
|
isCourseParticipant muid AuthTagActive{..} cid = E.exists . E.from $ \courseParticipant -> do
|
|
E.where_ $ E.just (courseParticipant E.^. CourseParticipantUser) E.==. E.val muid
|
|
E.&&. courseParticipant E.^. CourseParticipantCourse E.==. cid
|
|
E.&&. courseParticipant E.^. CourseParticipantState E.==. E.val CourseParticipantActive
|
|
E.&&. E.val (authTagIsActive AuthCourseRegistered) -- TODO is this the auth tag I want here?
|
|
|
|
isCourseAssociated :: Maybe UserId -> AuthTagActive -> E.SqlExpr (E.Value CourseId) -> E.SqlExpr (E.Value Bool)
|
|
isCourseAssociated muid ata cid =
|
|
isCourseLecturer muid ata cid
|
|
E.||. isCourseTutor muid ata cid
|
|
E.||. isCourseCorrector muid ata cid
|
|
E.||. isCourseParticipant muid ata cid
|
|
|
|
courseIsVisible :: UTCTime -> E.SqlExpr (Entity Course) -> E.SqlExpr (E.Value Bool)
|
|
courseIsVisible now course =
|
|
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
|
|
)
|
|
|
|
courseIsVisible' :: UTCTime -> Course -> Bool
|
|
courseIsVisible' now Course{..} = NTop courseVisibleFrom <= now' && now' <= NTop courseVisibleTo
|
|
where now' = NTop $ Just now
|
|
|
|
numCourseParticipants :: E.SqlExpr (E.Value CourseId) -> E.SqlExpr (E.Value Int)
|
|
numCourseParticipants cid = E.subSelectCount . E.from $ \courseParticipant ->
|
|
E.where_ $ courseParticipant E.^. CourseParticipantCourse E.==. cid
|
|
E.&&. courseParticipant E.^. CourseParticipantState E.==. E.val CourseParticipantActive
|