82 lines
3.3 KiB
Haskell
82 lines
3.3 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 as E
|
|
import qualified Database.Esqueleto.Utils as E
|
|
|
|
import qualified Data.Map as Map
|
|
import qualified Data.Set as Set
|
|
|
|
import qualified Data.CaseInsensitive as CI
|
|
|
|
|
|
getTCommR, postTCommR :: TermId -> SchoolId -> CourseShorthand -> TutorialName -> Handler Html
|
|
getTCommR = postTCommR
|
|
postTCommR tid ssh csh tutn = do
|
|
jSender <- requireAuthId
|
|
(cid, tutid) <- runDB $ fetchCourseIdTutorialId tid ssh csh tutn
|
|
|
|
commR CommunicationRoute
|
|
{ crHeading = SomeMessage . prependCourseTitle tid ssh csh $ SomeMessage MsgCommTutorialHeading
|
|
, crUltDest = SomeRoute $ CTutorialR tid ssh csh tutn TCommR
|
|
, crJobs = \Communication{..} -> do
|
|
let jSubject = cSubject
|
|
jMailContent = cBody
|
|
jCourse = cid
|
|
allRecipients = Set.toList $ Set.insert (Right jSender) cRecipients
|
|
jMailObjectUUID <- liftIO getRandom
|
|
jAllRecipientAddresses <- lift . fmap Set.fromList . forM allRecipients $ \case
|
|
Left email -> return . Address Nothing $ CI.original email
|
|
Right rid -> userAddress <$> getJust rid
|
|
forM_ allRecipients $ \jRecipientEmail ->
|
|
yield JobSendCourseCommunication{..}
|
|
, crRecipients = Map.fromList
|
|
[ ( RGTutorialParticipants
|
|
, 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
|
|
)
|
|
, ( 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
|
|
)
|
|
]
|
|
, 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
|
|
}
|