72 lines
2.7 KiB
Haskell
72 lines
2.7 KiB
Haskell
module Handler.Course.Communication
|
|
( postCCommR, getCCommR
|
|
) where
|
|
|
|
import Import
|
|
|
|
import Handler.Utils
|
|
import Handler.Utils.Communication
|
|
|
|
import qualified Data.CaseInsensitive as CI
|
|
|
|
import qualified Data.Set as Set
|
|
import qualified Data.Map as Map
|
|
|
|
import qualified Database.Esqueleto as E
|
|
|
|
|
|
getCCommR, postCCommR :: TermId -> SchoolId -> CourseShorthand -> Handler Html
|
|
getCCommR = postCCommR
|
|
postCCommR tid ssh csh = do
|
|
jSender <- requireAuthId
|
|
cid <- runDB . getKeyBy404 $ TermSchoolCourseShort tid ssh csh
|
|
|
|
commR CommunicationRoute
|
|
{ crHeading = SomeMessage . prependCourseTitle tid ssh csh $ SomeMessage MsgCommCourseHeading
|
|
, crUltDest = SomeRoute $ CourseR tid ssh csh CCommR
|
|
, 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
|
|
[ ( RGCourseParticipants
|
|
, E.from $ \(user `E.InnerJoin` participant) -> do
|
|
E.on $ user E.^. UserId E.==. participant E.^. CourseParticipantUser
|
|
E.where_ $ participant E.^. CourseParticipantCourse E.==. E.val cid
|
|
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.&&. user E.^. UserId E.==. corrector E.^. SheetCorrectorUser
|
|
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.&&. user E.^. UserId E.==. tutor E.^. TutorUser
|
|
return user
|
|
)
|
|
]
|
|
, crRecipientAuth = Just $ \uid -> do
|
|
cID <- encrypt uid
|
|
evalAccessDB (CourseR tid ssh csh $ CUserR cID) False
|
|
}
|