76 lines
3.1 KiB
Haskell
76 lines
3.1 KiB
Haskell
module Handler.Tutorial.Communication
|
|
( getTCommR, postTCommR
|
|
) where
|
|
|
|
import Import
|
|
import Handler.Utils
|
|
import Handler.Utils.Tutorial
|
|
import Handler.Utils.Communication
|
|
|
|
import qualified Database.Esqueleto.Legacy as E
|
|
import qualified Database.Esqueleto.Utils as E
|
|
|
|
import qualified Data.Map as Map
|
|
|
|
|
|
getTCommR, postTCommR :: TermId -> SchoolId -> CourseShorthand -> TutorialName -> Handler Html
|
|
getTCommR = postTCommR
|
|
postTCommR tid ssh csh tutn = do
|
|
((cid, tutid), usertuts) <- runDB $ do
|
|
tutData@(cid, _) <- fetchCourseIdTutorialId tid ssh csh tutn
|
|
tuts <- selectList [TutorialCourse ==. cid] []
|
|
usertuts <- forMaybeM tuts $ \(Entity tutid Tutorial{..}) -> do
|
|
cID <- encrypt tutid
|
|
guardM . lift . hasReadAccessTo $ CTutorialR tid ssh csh tutorialName TUsersR
|
|
return ( RGTutorialParticipants cID
|
|
, E.from $ \(user `E.InnerJoin` participant) -> do
|
|
E.on $ user E.^. UserId E.==. participant E.^. TutorialParticipantUser
|
|
E.where_ $ participant E.^. TutorialParticipantTutorial E.==. E.val tutid
|
|
return user
|
|
)
|
|
return (tutData, usertuts)
|
|
|
|
|
|
commR CommunicationRoute
|
|
{ crHeading = SomeMessage . prependCourseTitle tid ssh csh $ SomeMessage MsgCommTutorialHeading
|
|
, crUltDest = SomeRoute $ CTutorialR tid ssh csh tutn TCommR
|
|
, crJobs = crJobsCourseCommunication cid
|
|
, crTestJobs = crTestJobsCourseCommunication cid
|
|
, crRecipients = Map.fromList $
|
|
[ ( RGCourseLecturers
|
|
, E.from $ \(user `E.InnerJoin` lecturer) -> do
|
|
E.on $ user E.^. UserId E.==. lecturer E.^. LecturerUser
|
|
E.where_ $ lecturer E.^. LecturerCourse E.==. E.val cid
|
|
return user
|
|
)
|
|
, ( RGCourseCorrectors
|
|
, E.from $ \user -> do
|
|
E.where_ $ E.exists $ E.from $ \(sheet `E.InnerJoin` corrector) -> do
|
|
E.on $ sheet E.^. SheetId E.==. corrector E.^. SheetCorrectorSheet
|
|
E.where_ $ sheet E.^. SheetCourse E.==. E.val cid
|
|
E.&&. corrector E.^. SheetCorrectorUser E.==. user E.^. UserId
|
|
return user
|
|
)
|
|
, ( RGCourseTutors
|
|
, E.from $ \user -> do
|
|
E.where_ $ E.exists $ E.from $ \(tutorial `E.InnerJoin` tutor) -> do
|
|
E.on $ tutorial E.^. TutorialId E.==. tutor E.^. TutorTutorial
|
|
E.where_ $ tutorial E.^. TutorialCourse E.==. E.val cid
|
|
E.&&. tutor E.^. TutorUser E.==. user E.^. UserId
|
|
return user
|
|
)
|
|
] ++ usertuts
|
|
, crRecipientAuth = Just $ \uid -> do
|
|
isTutorialUser <- E.selectExists . E.from $ \tutorialUser ->
|
|
E.where_ $ tutorialUser E.^. TutorialParticipantUser E.==. E.val uid
|
|
E.&&. tutorialUser E.^. TutorialParticipantTutorial E.==. E.val tutid
|
|
|
|
isAssociatedCorrector <- evalAccessForDB (Just uid) (CourseR tid ssh csh CNotesR) False
|
|
isAssociatedTutor <- evalAccessForDB (Just uid) (CourseR tid ssh csh CTutorialListR) False
|
|
|
|
mr <- getMsgRenderer
|
|
return $ if
|
|
| isTutorialUser -> Authorized
|
|
| otherwise -> orAR mr isAssociatedCorrector isAssociatedTutor
|
|
}
|