136 lines
5.3 KiB
Haskell
136 lines
5.3 KiB
Haskell
{-# OPTIONS_GHC -fno-warn-unused-do-bind #-} -- ihamletFile discards do results
|
|
|
|
module Jobs.Handler.SendNotification.SubmissionEdited
|
|
( dispatchNotificationSubmissionEdited
|
|
, dispatchNotificationSubmissionUserCreated
|
|
, dispatchNotificationSubmissionUserDeleted
|
|
) where
|
|
|
|
import Import
|
|
|
|
import Handler.Utils
|
|
import Jobs.Handler.SendNotification.Utils
|
|
|
|
import Text.Hamlet
|
|
|
|
import qualified Database.Esqueleto.Legacy as E
|
|
|
|
import qualified Data.Text as Text
|
|
|
|
|
|
dispatchNotificationSubmissionEdited :: UserId -> SubmissionId -> UserId -> Handler ()
|
|
dispatchNotificationSubmissionEdited nInitiator nSubmission jRecipient = userMailT jRecipient $ do
|
|
(Course{..}, Sheet{..}, Submission{}, initiator, coSubmittors) <- liftHandler . runDB $ do
|
|
submission <- getJust nSubmission
|
|
sheet <- belongsToJust submissionSheet submission
|
|
course <- belongsToJust sheetCourse sheet
|
|
|
|
initiator <- getJust nInitiator
|
|
|
|
coSubmittors <- E.select . E.from $ \(submissionUser `E.InnerJoin` user) -> do
|
|
E.on $ submissionUser E.^. SubmissionUserUser E.==. user E.^. UserId
|
|
E.where_ $ submissionUser E.^. SubmissionUserSubmission E.==. E.val nSubmission
|
|
E.&&. user E.^. UserId E.!=. E.val jRecipient
|
|
return user
|
|
|
|
return (course, sheet, submission, initiator, coSubmittors)
|
|
|
|
let allCoSubmittors = Text.intercalate ", " $ map (renderAddress . userAddressFrom . entityVal) coSubmittors
|
|
addMailHeader "Reply-To" allCoSubmittors
|
|
|
|
replaceMailHeader "Auto-Submitted" $ Just "auto-generated"
|
|
setSubjectI $ MsgMailSubjectSubmissionEdited courseShorthand sheetName
|
|
|
|
csid <- encrypt nSubmission
|
|
MsgRenderer mr <- getMailMsgRenderer
|
|
let termDesc = mr . ShortTermIdentifier $ unTermKey courseTerm
|
|
tid = courseTerm
|
|
ssh = courseSchool
|
|
csh = courseShorthand
|
|
shn = sheetName
|
|
|
|
editNotifications <- mkEditNotifications jRecipient
|
|
|
|
addHtmlMarkdownAlternatives $(ihamletFile "templates/mail/submissionEdited.hamlet")
|
|
|
|
dispatchNotificationSubmissionUserCreated :: UserId -> SubmissionId -> UserId -> Handler ()
|
|
dispatchNotificationSubmissionUserCreated nUser nSubmission jRecipient = userMailT jRecipient $ do
|
|
(User{..}, Course{..}, Sheet{..}, Submission{}, coSubmittors) <- liftHandler . runDB $ do
|
|
submission <- getJust nSubmission
|
|
sheet <- belongsToJust submissionSheet submission
|
|
course <- belongsToJust sheetCourse sheet
|
|
|
|
coSubmittors <- E.select . E.from $ \(submissionUser `E.InnerJoin` user) -> do
|
|
E.on $ submissionUser E.^. SubmissionUserUser E.==. user E.^. UserId
|
|
E.where_ $ submissionUser E.^. SubmissionUserSubmission E.==. E.val nSubmission
|
|
E.&&. user E.^. UserId E.!=. E.val jRecipient
|
|
return user
|
|
|
|
user <- getJust nUser
|
|
|
|
return (user, course, sheet, submission, coSubmittors)
|
|
|
|
let isSelf = nUser == jRecipient
|
|
|
|
let allCoSubmittors = Text.intercalate ", " $ map (renderAddress . userAddressFrom . entityVal) coSubmittors
|
|
addMailHeader "Reply-To" allCoSubmittors
|
|
|
|
replaceMailHeader "Auto-Submitted" $ Just "auto-generated"
|
|
setSubjectI $ if
|
|
| isSelf -> MsgMailSubjectSubmissionUserCreated courseShorthand sheetName
|
|
| otherwise -> MsgMailSubjectSubmissionUserCreatedOther userDisplayName courseShorthand sheetName
|
|
|
|
csid <- encrypt nSubmission
|
|
MsgRenderer mr <- getMailMsgRenderer
|
|
let termDesc = mr . ShortTermIdentifier $ unTermKey courseTerm
|
|
tid = courseTerm
|
|
ssh = courseSchool
|
|
csh = courseShorthand
|
|
shn = sheetName
|
|
|
|
editNotifications <- mkEditNotifications jRecipient
|
|
|
|
addHtmlMarkdownAlternatives $(ihamletFile "templates/mail/submissionUserCreated.hamlet")
|
|
|
|
|
|
dispatchNotificationSubmissionUserDeleted :: UserId -> SheetId -> SubmissionId -> UserId -> Handler ()
|
|
dispatchNotificationSubmissionUserDeleted nUser nSheet nSubmission jRecipient = userMailT jRecipient $ do
|
|
(User{..}, Course{..}, Sheet{..}, mSubmission, coSubmittors) <- liftHandler . runDB $ do
|
|
submission <- get nSubmission
|
|
|
|
sheet <- maybe (getJust nSheet) (belongsToJust submissionSheet) submission
|
|
course <- belongsToJust sheetCourse sheet
|
|
|
|
coSubmittors <- E.select . E.from $ \(submissionUser `E.InnerJoin` user) -> do
|
|
E.on $ submissionUser E.^. SubmissionUserUser E.==. user E.^. UserId
|
|
E.where_ $ submissionUser E.^. SubmissionUserSubmission E.==. E.val nSubmission
|
|
E.&&. user E.^. UserId E.!=. E.val jRecipient
|
|
return user
|
|
|
|
user <- getJust nUser
|
|
|
|
return (user, course, sheet, submission, coSubmittors)
|
|
|
|
let isSelf = nUser == jRecipient
|
|
|
|
unless (null coSubmittors) $ do
|
|
let allCoSubmittors = Text.intercalate ", " $ map (renderAddress . userAddressFrom . entityVal) coSubmittors
|
|
addMailHeader "Reply-To" allCoSubmittors
|
|
|
|
replaceMailHeader "Auto-Submitted" $ Just "auto-generated"
|
|
setSubjectI $ if
|
|
| isSelf -> MsgMailSubjectSubmissionUserDeleted courseShorthand sheetName
|
|
| otherwise -> MsgMailSubjectSubmissionUserDeletedOther userDisplayName courseShorthand sheetName
|
|
|
|
csid <- guardOn (is _Just mSubmission) <$> encrypt nSubmission
|
|
MsgRenderer mr <- getMailMsgRenderer
|
|
let termDesc = mr . ShortTermIdentifier $ unTermKey courseTerm
|
|
tid = courseTerm
|
|
ssh = courseSchool
|
|
csh = courseShorthand
|
|
shn = sheetName
|
|
|
|
editNotifications <- mkEditNotifications jRecipient
|
|
|
|
addHtmlMarkdownAlternatives $(ihamletFile "templates/mail/submissionUserDeleted.hamlet")
|