fraport/fradrive
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

feat(submission): edit notifications

Browse Source
This commit is contained in:
Gregor Kleen 2019-12-05 13:44:47 +01:00
parent e87f6075d3
commit 98c0d6919e
20 changed files with 360 additions and 39 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
messages/uniworx/de-de-formal.msg
View File

@ -826,6 +826,21 @@ EnglishEurope: Englisch (Europa)
MailSubjectSubmissionRated csh@CourseShorthand: Ihre #{csh}-Abgabe wurde korrigiert
MailSubmissionRatedIntro courseName@Text termDesc@Text: Ihre Abgabe im Kurs #{courseName} (#{termDesc}) wurde korrigiert.
MailSubjectSubmissionEdited csh@CourseShorthand shn@SheetName: Ihre Abgabe für #{shn} im Kurs #{csh} wurde verändert
MailSubmissionEditedIntro coursen@CourseName shn@SheetName termDesc@Text displayName@Text: #{displayName} hat Ihre Abgabe für #{shn} im Kurs #{coursen} (#{termDesc}) verändert.
MailSubjectSubmissionUserCreated csh@CourseShorthand shn@SheetName: Sie wurden als Mitabgebender zu einer Abgabe für #{shn} im Kurs #{csh} hinzugefügt
MailSubjectSubmissionUserCreatedOther displayName@Text csh@CourseShorthand shn@SheetName: Es wurde ein Mitabgebender zu einer Abgabe für #{shn} im Kurs #{csh} hinzugefügt
MailSubmissionUserCreatedIntro coursen@CourseName shn@SheetName termDesc@Text: Sie wurden als Mitabgebender zu einer Abgabe für #{shn} im Kurs #{coursen} (#{termDesc}) hinzugefügt.
MailSubmissionUserCreatedOtherIntro displayName@UserDisplayName coursen@CourseName shn@SheetName termDesc@Text: #{displayName} wurde als Mitabgebender zu einer Abgabe für #{shn} im Kurs #{coursen} (#{termDesc}) hinzugefügt.
MailSubjectSubmissionUserDeleted csh@CourseShorthand shn@SheetName: Sie wurden als Mitabgebender von Ihrer Abgabe für #{shn} im Kurs #{csh} entfernt
MailSubjectSubmissionUserDeletedOther displayName@Text csh@CourseShorthand shn@SheetName: Es wurde ein Mitabgebender von einer Abgabe für #{shn} im Kurs #{csh} entfernt
MailSubmissionUserDeletedIntro coursen@CourseName shn@SheetName termDesc@Text: Sie wurden als Mitabgebender von Ihrer Abgabe für #{shn} im Kurs #{coursen} (#{termDesc}) entfernt.
MailSubmissionUserDeletedOtherIntro displayName@UserDisplayName coursen@CourseName shn@SheetName termDesc@Text: #{displayName} wurde als Mitabgebender von einer Abgabe für #{shn} im Kurs #{coursen} (#{termDesc}) entfernt.
MailSubjectSheetActive csh@CourseShorthand sheetName@SheetName: #{sheetName} in #{csh} wurde herausgegeben
MailSheetActiveIntro courseName@Text termDesc@Text sheetName@SheetName: Sie können nun #{sheetName} im Kurs #{courseName} (#{termDesc}) herunterladen.
@ -967,6 +982,9 @@ NotificationTriggerAllocationResults: Plätze wurden für eine meiner Zentralanm
NotificationTriggerExamOfficeExamResults: Ich kann neue Prüfungsergebnisse einsehen
NotificationTriggerExamOfficeExamResultsChanged: Prüfungsergebnisse wurden verändert
NotificationTriggerCourseRegistered: Ein Kursverwalter hat mich zu einem Kurs angemeldet
NotificationTriggerSubmissionUserCreated: Ich wurde als Mitabgebender zu einer Übungsblatt-Abgabe hinzugefügt
NotificationTriggerSubmissionEdited: Eine meiner Übungsblatt-Abgaben wurde verändert
NotificationTriggerSubmissionUserDeleted: Ich wurde als Mitabgebender von einer Übungsblatt-Abgabe entfernt
NotificationTriggerKindAll: Für alle Benutzer
NotificationTriggerKindCourseParticipant: Für Kursteilnehmer
@ -979,6 +997,7 @@ NotificationTriggerKindExamOffice: Für das Prüfungsamt
NotificationTriggerKindEvaluation: Für Vorlesungsumfragen
NotificationTriggerKindAllocationStaff: Für Zentralanmeldungen (Dozenten)
NotificationTriggerKindAllocationParticipant: Für Zentralanmeldungen
NotificationTriggerKindSubmissionUser: Für Mitabgebende einer Übungsblatt-Abgabe
CorrCreate: Abgaben registrieren
UnknownPseudonymWord pseudonymWord@Text: Unbekanntes Pseudonym-Wort "#{pseudonymWord}"

67
messages/uniworx/en-eu.msg
View File

@ -1,4 +1,4 @@
PrintDebugForStupid name@Text: Debug message "#{name}"
PrintDebugForStupid name: Debug message "#{name}"
Logo: Uni2work
@ -160,17 +160,17 @@ CourseUserNoteTooltip: Only visible to administrators of this course
CourseUserNoteSaved: Successfully saved note changes
CourseUserNoteDeleted: Successfully deleted user note deleted
CourseUserDeregister: Deregister from course
CourseUsersDeregistered count@Int64: Successfully deregistered #{show count} users from course
CourseUsersDeregistered count: Successfully deregistered #{show count} users from course
CourseUserRegisterTutorial: Register for a tutorial
CourseUsersTutorialRegistered count@Int64: Successfully registered #{show count} users for tutorial
CourseUsersTutorialRegistered count: Successfully registered #{show count} users for tutorial
CourseUserSendMail: Send mail
TutorialUserDeregister: Deregister from tutorial
TutorialUserSendMail: Send mail
TutorialUsersDeregistered count@Int64: Successfully deregistered #{show count} participants from tutorial
TutorialUsersDeregistered count: Successfully deregistered #{show count} participants from tutorial
CourseAllocationParticipate: Participate in central allocation
CourseAllocationParticipateTip: If a course participates in a central allocation, you might lose some permissions that you would normally have (e.g. registering students for the course directly, deregistering students, ...)
CourseAllocation: Central allocation
CourseAllocationOption term@Text name@Text: #{name} (#{term})
CourseAllocationOption term name: #{name} (#{term})
CourseAllocationMinCapacity: Minimum number of participants
CourseAllocationMinCapacityTip: If fewer students than this number were to be assigned to this course, then these students would instead be assigned to other courses
CourseAllocationMinCapacityMustBeNonNegative: Minimum number of participants must not be negative
@ -343,6 +343,8 @@ NoOpenSubmissions: No open submissions exist
SubmissionsDeleteQuestion n: Do you really want to delete the #{pluralEN n "submission" "submissions"} mentioned below?
SubmissionsDeleted n: #{pluralEN n "Submission" "Submissions"} deleted
SubmissionDeleteCosubmittorsWarning n: You are not the only participant for #{pluralEN n "the submission" "all submissions"} mentioned above. Ensure that you delete submissions only in agreement with your co-submittors or remove yourself from the #{pluralEN n "submission" "submissions"}, instead!
SubmissionGroupName: Group name
CorrectionsTitle: Assigned corrections
@ -676,7 +678,7 @@ FormNotifications: Notifications
FormBehaviour: Behaviour
FormCosmetics: Interface
FormPersonalAppearance: Public data
FormFieldRequiredTip: Marked fields need to be filled
FormFieldRequiredTip: Required fields
PersonalInfoExamAchievementsWip: The feature to display your exam achievements has not yet been implemented.
PersonalInfoOwnTutorialsWip: The feature to display tutorials you have been assigned to as tutor has not yet been implemented.
@ -821,6 +823,24 @@ EnglishEurope: English (Europe)
MailSubjectSubmissionRated csh: Your #{csh}-submission was marked
MailSubmissionRatedIntro courseName termDesc: Your submission for #{courseName} (#{termDesc}) was marked.
MailSubjectSubmissionEdited csh shn: Your submisson for #{shn} in #{csh} was edited
MailSubmissionEditedIntro coursen shn termDesc displayName: #{displayName} edited your submission for #{shn} in #{coursen} (#{termDesc}).
MailSubjectSubmissionUserCreated csh shn: You were added to a submission for #{shn} in #{csh}
MailSubjectSubmissionUserCreatedOther displayName csh shn: An user was added to a submission for #{shn} in #{csh}
MailSubmissionUserCreatedIntro coursen shn termDesc: You were added to a submission for #{shn} in #{coursen} (#{termDesc}).
MailSubmissionUserCreatedOtherIntro displayName coursen shn termDesc: #{displayName} was added as to a submission for #{shn} in #{coursen} (#{termDesc}).
MailSubjectSubmissionUserDeleted csh shn: You were removed from your submission for #{shn} in #{csh}
MailSubjectSubmissionUserDeletedOther displayName csh shn: An user was removed from your submission for #{shn} in #{csh}
MailSubmissionUserDeletedIntro coursen shn termDesc: You were removed from your submission for #{shn} in #{coursen} (#{termDesc}).
MailSubmissionUserDeletedOtherIntro displayName coursen shn termDesc: #{displayName} was removed from your submission for #{shn} in #{coursen} (#{termDesc}).
MailSubjectSheetActive csh sheetName: #{sheetName} in #{csh} was released
MailSheetActiveIntro courseName termDesc sheetName: You may now download #{sheetName} for #{courseName} (#{termDesc}).
@ -962,6 +982,9 @@ NotificationTriggerAllocationResults: Participants have been placed by one of my
NotificationTriggerExamOfficeExamResults: New exam results are available
NotificationTriggerExamOfficeExamResultsChanged: Exam results have changed
NotificationTriggerCourseRegistered: A course administrator has enrolled me in a course
NotificationTriggerSubmissionUserCreated: I was added to an exercise sheet submission
NotificationTriggerSubmissionEdited: One of my exercise sheet submissions was changed
NotificationTriggerSubmissionUserDeleted: I was removed from one of my exercise sheet submissions
NotificationTriggerKindAll: For all users
NotificationTriggerKindCourseParticipant: For course participants
@ -974,6 +997,7 @@ NotificationTriggerKindExamOffice: For the exam office
NotificationTriggerKindEvaluation: For course evaluations
NotificationTriggerKindAllocationStaff: For central allocations (lecturers)
NotificationTriggerKindAllocationParticipant: For central allocations
NotificationTriggerKindSubmissionUser: For participants in an exercise sheet submission
CorrCreate: Register submissions
UnknownPseudonymWord pseudonymWord: Invalid pseudonym-word “#{pseudonymWord}”
@ -1050,25 +1074,25 @@ MessageSuccess: Success
InvalidLangFormat: Invalid language code (RFC1766)
ErrorResponseTitleNotFound: Resource not found
ErrorResponseTitleInternalError internalError@Text: An internal error occurred
ErrorResponseTitleInvalidArgs invalidArgs@Texts: Request contained invalid arguments
ErrorResponseTitleInternalError internalError: An internal error occurred
ErrorResponseTitleInvalidArgs invalidArgs: Request contained invalid arguments
ErrorResponseTitleNotAuthenticated: Request requires authentication
ErrorResponseTitlePermissionDenied permissionDenied@Text: Permission denied
ErrorResponseTitleBadMethod requestMethod@Method: HTTP-method not supported
ErrorResponseTitlePermissionDenied permissionDenied: Permission denied
ErrorResponseTitleBadMethod requestMethod: HTTP-method not supported
UnknownErrorResponse: An error has occurred that could not be further classified:
ErrorResponseNotFound: No page could be found under the url requested by your browser.
ErrorResponseNotAuthenticated: To be granted access to most parts of Uni2work you need to login first.
ErrorResponseBadMethod requestMethodText@Text: Your browser can interact in multiple ways with the resources offered by Uni2work. The requested method (#{requestMethodText}) is not supported here.
ErrorResponseBadMethod requestMethodText: Your browser can interact in multiple ways with the resources offered by Uni2work. The requested method (#{requestMethodText}) is not supported here.
ErrorResponseEncrypted: In order not to reveal sensitive information further details have been encrypted. If you send a support request, please include the encrypted data listed below.
ErrMsgCiphertext: Encrypted error message
EncodedSecretBoxCiphertextTooShort: Encrypted data are too short to be valid
EncodedSecretBoxInvalidBase64 base64Err@String: Encrypted data ar not correctly base64url-encoded: #{base64Err}
EncodedSecretBoxInvalidBase64 base64Err: Encrypted data ar not correctly base64url-encoded: #{base64Err}
EncodedSecretBoxInvalidPadding: Encrypted data are not padded correctly
EncodedSecretBoxCouldNotDecodeNonce: Could not decode secretbox-nonce
EncodedSecretBoxCouldNotOpenSecretBox: Could not open libsodium-secretbox (Encrypted data are not authentic)
EncodedSecretBoxCouldNotDecodePlaintext aesonErr@String: Could not decode json cleartext: #{aesonErr}
EncodedSecretBoxCouldNotDecodePlaintext aesonErr: Could not decode json cleartext: #{aesonErr}
ErrMsgHeading: Decrypt error message
InvalidRoute: Could not interpret url
@ -1136,7 +1160,7 @@ MenuCorrectionsDownload: Download corrections
MenuCorrectionsCreate: Register submissions
MenuCorrectionsGrade: Grade submissions
MenuCorrectionsAssign: Assign corrections
MenuCorrectionsAssignSheet name@Text: Assign corrections for #{name}
MenuCorrectionsAssignSheet name: Assign corrections for #{name}
MenuAuthPreds: Authorisation settings
MenuTutorialDelete: Delete tutorial
MenuTutorialEdit: Edit tutorial
@ -1840,6 +1864,7 @@ AllocationSchoolShort: Department
Allocation: Central allocation
AllocationRegisterTo: Registration until
AllocationListTitle: Central allocations
CourseApplicationsListTitle: Applications
@ -1910,16 +1935,16 @@ ExamOfficeSubscribedUsersTip: You may specify multiple matriculations; comma-sep
ExamOfficeSubscribedUsersExplanation: You will be able to view all exam achievements (with no regard for the students fields of study) for all users specified here.
ExamOfficeSubscribedFieldsExplanation: You will be able to view all exam achievements for any user that has at least one of the specified fields of study. You may additionally configure whether users should be allowed to opt out on a course by course basis.
UserMatriculationNotFound matriculation@Text: Es existiert kein Uni2work-Benutzer mit Matrikelnummer „#{matriculation}“
UserMatriculationAmbiguous matriculation@Text: Matrikelnummer „#{matriculation}“ ist nicht eindeutig
UserMatriculationNotFound matriculation: There is no uni2work-user with matriculation “#{matriculation}”
UserMatriculationAmbiguous matriculation: Matriculation “#{matriculation}” isn't unique
TransactionExamOfficeUsersUpdated nDeleted@Int nAdded@Int: #{nAdded} Benutzer hinzugefügt, #{nDeleted} Benutzer gelöscht
TransactionExamOfficeUsersUpdated nDeleted nAdded: Added #{nAdded} #{pluralEN nAdded "user" "users"}, deleted #{nDeleted}
TransactionExamOfficeFieldsUpdated nUpdates@Int: #{nUpdates} #{pluralDE nUpdates "Studienfach" "Studienfächer"} angepasst
TransactionExamOfficeFieldsUpdated nUpdates: Edited #{nUpdates} #{pluralEN nUpdates "field of study" "fields of study"}
ExamOfficeFieldNotSubscribed: —
ExamOfficeFieldSubscribed: Einsicht
ExamOfficeFieldForced: Forcierte Einsicht
InvalidExamOfficeFieldMode parseErr@Text: Konnte „#{parseErr}“ nicht interpretieren
ExamOfficeFieldSubscribed: Access
ExamOfficeFieldForced: Forced access
InvalidExamOfficeFieldMode parseErr: Could not parse “#{parseErr}”
LdapIdentification: Campus account
LdapIdentificationOrEmail: Campus account/email address

30
src/Handler/Corrections.hs
View File

@ -904,11 +904,11 @@ postCorrectionsCreateR = do
forM_ (Map.toList invalids) $ \((oPseudonyms, iPseudonym), alts) -> $(addMessageFile Error "templates/messages/ignoredInvalidPseudonym.hamlet")
tell . All $ null invalids
WriterT . runDB . mapReaderT runWriterT $ do
Sheet{..} <- get404 sid
WriterT . runDBJobs . mapReaderT (mapWriterT $ fmap ((,) <$> ((,) <$> view (_1 . _1) <*> view _2) <*> view (_1 . _2)) . runWriterT) $ do
Sheet{..} <- get404 sid :: ReaderT SqlBackend (WriterT (Set QueuedJobId) (WriterT All (HandlerFor UniWorX))) Sheet
(sps, unknown) <- fmap partitionEithers' . forM pss . mapM $ \p -> maybe (Left p) Right <$> getBy (UniqueSheetPseudonym sid p)
forM_ unknown $ addMessageI Error . MsgUnknownPseudonym . review _PseudonymText
tell . All $ null unknown
lift . lift . tell . All $ null unknown
now <- liftIO getCurrentTime
let
sps' :: [[SheetPseudonym]]
@ -935,7 +935,7 @@ postCorrectionsCreateR = do
E.&&. submission E.^. SubmissionSheet E.==. E.val sid
return submissionUser
unless (null existingSubUsers) . mapReaderT lift $ do
(Map.toList -> subs) <- foldrM (\(Entity _ SubmissionUser{..}) mp -> Map.insertWith (<>) <$> (encrypt submissionUserSubmission :: DB CryptoFileNameSubmission) <*> pure (Set.fromList . map sheetPseudonymPseudonym . filter (\SheetPseudonym{..} -> sheetPseudonymUser == submissionUserUser) $ concat sps') <*> pure mp) Map.empty existingSubUsers
(Map.toList -> subs) <- foldrM (\(Entity _ SubmissionUser{..}) mp -> Map.insertWith (<>) <$> (encrypt submissionUserSubmission :: _ CryptoFileNameSubmission) <*> pure (Set.fromList . map sheetPseudonymPseudonym . filter (\SheetPseudonym{..} -> sheetPseudonymUser == submissionUserUser) $ concat sps') <*> pure mp) Map.empty existingSubUsers
let trigger = [whamlet|_{MsgSheetCreateExisting}|]
content = Right $(widgetFile "messages/submissionCreateExisting")
addMessageModal Warning trigger content
@ -952,7 +952,9 @@ postCorrectionsCreateR = do
{ submissionUserUser = sheetPseudonymUser
, submissionUserSubmission = subId
}
forM_ spGroup $ \SheetPseudonym{sheetPseudonymUser} -> audit $ TransactionSubmissionUserEdit subId sheetPseudonymUser
forM_ spGroup $ \SheetPseudonym{sheetPseudonymUser} -> do
hoist (hoist lift) . queueDBJob . JobQueueNotification $ NotificationSubmissionUserCreated uid subId
audit $ TransactionSubmissionUserEdit subId sheetPseudonymUser
when (genericLength spGroup > maxSize) $
addMessageI Warning $ MsgSheetGroupTooLarge sheetGroupDesc
RegisteredGroups -> do
@ -975,14 +977,16 @@ postCorrectionsCreateR = do
{ submissionUserUser = sheetUser
, submissionUserSubmission = subId
}
forM_ groupUsers $ audit . TransactionSubmissionUserEdit subId
forM_ groupUsers $ \subUid -> do
hoist (hoist lift) . queueDBJob . JobQueueNotification $ NotificationSubmissionUserCreated subUid subId
audit $ TransactionSubmissionUserEdit subId subUid
when (null groups) $
addMessageI Warning $ MsgSheetNoRegisteredGroup sheetGroupDesc
| length groups < 2
-> do
forM_ (Set.toList (Map.keysSet spGroup' `Set.difference` groupUsers)) $ \((spGroup' !) -> SheetPseudonym{sheetPseudonymPseudonym}) -> do
addMessageI Error $ MsgSheetNoRegisteredGroup (review _PseudonymText sheetPseudonymPseudonym)
tell $ All False
lift . lift . tell $ All False
| otherwise ->
addMessageI Error $ MsgSheetAmbiguousRegisteredGroup sheetGroupDesc
NoGroups -> do
@ -993,7 +997,9 @@ postCorrectionsCreateR = do
{ submissionUserUser = sheetPseudonymUser
, submissionUserSubmission = subId
}
forM_ spGroup $ \SheetPseudonym{sheetPseudonymUser} -> audit $ TransactionSubmissionUserEdit subId sheetPseudonymUser
forM_ spGroup $ \SheetPseudonym{sheetPseudonymUser} -> do
hoist (hoist lift) . queueDBJob . JobQueueNotification $ NotificationSubmissionUserCreated uid subId
audit $ TransactionSubmissionUserEdit subId sheetPseudonymUser
when (length spGroup > 1) $
addMessageI Warning $ MsgSheetNoGroupSubmission sheetGroupDesc
when allDone $
@ -1080,10 +1086,10 @@ postCorrectionsGradeR = do
| submissionRatingPoints /= mPoints || submissionRatingComment /= mComment || rated /= submissionRatingDone s
-> do audit $ TransactionSubmissionEdit subId $ s ^. _submissionSheet
Just subId <$ update subId [ SubmissionRatingPoints =. mPoints
, SubmissionRatingComment =. mComment
, SubmissionRatingBy =. Just uid
, SubmissionRatingTime =. now <$ guard rated
]
, SubmissionRatingComment =. mComment
, SubmissionRatingBy =. Just uid
, SubmissionRatingTime =. now <$ guard rated
]
| otherwise -> return Nothing
subs' <- traverse (\x -> (,) <$> encrypt x <*> encrypt x) subs :: Handler [(CryptoFileNameSubmission, CryptoUUIDSubmission)]
let trigger = [whamlet|_{MsgCorrectionsUploaded (genericLength subs')}|]

2
src/Handler/Course/Events/Delete.hs
View File

@ -46,7 +46,7 @@ postCEvDeleteR tid ssh csh cID = do
drFormMessage :: [Entity CourseEvent] -> DB (Maybe Message)
drFormMessage _ = return Nothing
drDelete :: forall a. CourseEventId -> DB a -> DB a
drDelete :: forall a. CourseEventId -> JobDB a -> JobDB a
drDelete _ = id
deleteR DeleteRoute{..}

2
src/Handler/Course/News/Delete.hs
View File

@ -41,7 +41,7 @@ postCNDeleteR tid ssh csh cID = do
drFormMessage :: [Entity CourseNews] -> DB (Maybe Message)
drFormMessage _ = return Nothing
drDelete :: forall a. CourseNewsId -> DB a -> DB a
drDelete :: forall a. CourseNewsId -> JobDB a -> JobDB a
drDelete _ = id
deleteR DeleteRoute{..}

9
src/Handler/Profile.hs
View File

@ -51,6 +51,7 @@ makeLenses_ ''SettingsForm
data NotificationTriggerKind
= NTKAll
| NTKCourseParticipant
| NTKSubmissionUser
| NTKExamParticipant
| NTKCorrector
| NTKCourseLecturer
@ -64,6 +65,7 @@ instance RenderMessage UniWorX NotificationTriggerKind where
renderMessage f ls = \case
NTKAll -> mr MsgNotificationTriggerKindAll
NTKCourseParticipant -> mr MsgNotificationTriggerKindCourseParticipant
NTKSubmissionUser -> mr MsgNotificationTriggerKindSubmissionUser
NTKExamParticipant -> mr MsgNotificationTriggerKindExamParticipant
NTKCorrector -> mr MsgNotificationTriggerKindCorrector
NTKCourseLecturer -> mr MsgNotificationTriggerKindCourseLecturer
@ -158,6 +160,10 @@ notificationForm template = wFormToAForm $ do
= fmap not . E.selectExists . E.from $ \courseParticipant ->
E.where_ $ courseParticipant E.^. CourseParticipantUser E.==. E.val uid
| Just uid <- mbUid
, NTKSubmissionUser <- nt
= fmap not . E.selectExists . E.from $ \submissionUser ->
E.where_ $ submissionUser E.^. SubmissionUserUser E.==. E.val uid
| Just uid <- mbUid
, NTKExamParticipant <- nt
= fmap not . E.selectExists . E.from $ \examRegistration ->
E.where_ $ examRegistration E.^. ExamRegistrationUser E.==. E.val uid
@ -186,6 +192,9 @@ notificationForm template = wFormToAForm $ do
ntSection = \case
NTSubmissionRatedGraded -> Just NTKCourseParticipant
NTSubmissionRated -> Just NTKCourseParticipant
NTSubmissionUserCreated -> Just NTKCourseParticipant
NTSubmissionUserDeleted -> Just NTKSubmissionUser
NTSubmissionEdited -> Just NTKSubmissionUser
NTSheetActive -> Just NTKCourseParticipant
NTSheetSoonInactive -> Just NTKCourseParticipant
NTSheetInactive -> Just NTKCourseLecturer

4
src/Handler/Submission.hs
View File

@ -503,12 +503,16 @@ submissionHelper tid ssh csh shn mcid = do
-- user exists and has an id => insert as SubmissionUser and audit
insert_ $ SubmissionUser subUid smid
audit $ TransactionSubmissionUserEdit smid subUid
unless (subUid == uid) $
queueDBJob . JobQueueNotification $ NotificationSubmissionUserCreated subUid smid
-- change is an old user that is not a submission user anymore => delete invitation / delete
| otherwise -> case change of
Left subEmail -> deleteInvitation @SubmissionUser smid subEmail
Right subUid -> do
deleteBy $ UniqueSubmissionUser subUid smid
audit $ TransactionSubmissionUserDelete smid subUid
unless (subUid == uid) $
queueDBJob . JobQueueNotification $ NotificationSubmissionUserDeleted subUid shid smid
addMessageI Success $ if | Nothing <- msmid -> MsgSubmissionCreated
| otherwise -> MsgSubmissionUpdated

7
src/Handler/Utils/Delete.hs
View File

@ -12,6 +12,7 @@ module Handler.Utils.Delete
( DeleteRoute(..)
, deleteR
, postDeleteR, getDeleteR
, JobDB
) where
import Import
@ -28,6 +29,8 @@ import qualified Database.Esqueleto as E
import qualified Database.Esqueleto.Internal.Sql as E (SqlSelect)
import qualified Database.Esqueleto.Internal.Language as E (From)
import Jobs.Queue
data DeleteRoute record = forall tables infoExpr info. (E.SqlSelect infoExpr info, E.From tables) => DeleteRoute
{ drRecords :: Set (Key record) -- ^ Records to be deleted
@ -40,7 +43,7 @@ data DeleteRoute record = forall tables infoExpr info. (E.SqlSelect infoExpr inf
, drSuccessMessage :: SomeMessage UniWorX
, drAbort
, drSuccess :: SomeRoute UniWorX
, drDelete :: forall a. Key record -> DB a -> DB a
, drDelete :: forall a. Key record -> JobDB a -> JobDB a
}
confirmForm :: ( MonadHandler m, HandlerSite m ~ UniWorX )
@ -101,7 +104,7 @@ deleteR' DeleteRoute{..} = do
formResult confirmRes $ \case
True -> do
runDB $ do
runDBJobs $ do
forM_ drRecords $ \k -> drDelete k $ deleteCascade k
addMessageI Success drSuccessMessage
redirect drSuccess

17
src/Handler/Utils/Submission.hs
View File

@ -626,6 +626,12 @@ sinkSubmission userId mExists isUpdate = do
| isUpdate
, getAny sinkSubmissionNotifyRating
-> queueDBJob . JobQueueNotification $ NotificationSubmissionRated submissionId
| not isUpdate
, getAny sinkSubmissionTouched
, is _Right mExists
-> do
uid <- requireAuthId
queueDBJob . JobQueueNotification $ NotificationSubmissionEdited uid submissionId
| otherwise -> return ()
@ -763,5 +769,14 @@ submissionDeleteRoute drRecords = DeleteRoute
, drSuccessMessage = SomeMessage $ MsgSubmissionsDeleted 1
, drAbort = error "drAbort undefined"
, drSuccess = error "drSuccess undefined"
, drDelete = \subId del -> getJust subId >>= \sub -> audit (TransactionSubmissionDelete subId $ sub ^. _submissionSheet) >> del
, drDelete = \subId del -> do
Submission{..} <- getJust subId
subUsers <- setOf (folded . _entityVal . _submissionUserUser) <$> selectList [SubmissionUserSubmission ==. subId] []
audit $ TransactionSubmissionDelete subId submissionSheet
uid <- requireAuthId
forM_ (Set.delete uid subUsers) $ \subUid ->
queueDBJob . JobQueueNotification $ NotificationSubmissionUserDeleted subUid submissionSheet subId
del
}

13
src/Jobs/Handler/QueueNotification.hs
View File

@ -225,6 +225,16 @@ determineNotificationCandidates notif@NotificationAllocationResults{..} = do
return user
determineNotificationCandidates NotificationCourseRegistered{..} =
maybeToList <$> getEntity nUser
determineNotificationCandidates NotificationSubmissionEdited{..} =
E.select . E.from $ \(user `E.InnerJoin` submissionUser) -> do
E.on $ user E.^. UserId E.==. submissionUser E.^. SubmissionUserUser
E.where_ $ submissionUser E.^. SubmissionUserSubmission E.==. E.val nSubmission
E.&&. user E.^. UserId E.!=. E.val nInitiator
return user
determineNotificationCandidates NotificationSubmissionUserCreated{..} =
maybeToList <$> getEntity nUser
determineNotificationCandidates NotificationSubmissionUserDeleted{..} =
maybeToList <$> getEntity nUser
classifyNotification :: Notification -> DB NotificationTrigger
@ -253,3 +263,6 @@ classifyNotification NotificationExamOfficeExamResults{} = return NTExa
classifyNotification NotificationExamOfficeExamResultsChanged{} = return NTExamOfficeExamResultsChanged
classifyNotification NotificationAllocationResults{} = return NTAllocationResults
classifyNotification NotificationCourseRegistered{} = return NTCourseRegistered
classifyNotification NotificationSubmissionEdited{} = return NTSubmissionEdited
classifyNotification NotificationSubmissionUserCreated{} = return NTSubmissionUserCreated
classifyNotification NotificationSubmissionUserDeleted{} = return NTSubmissionUserDeleted

1
src/Jobs/Handler/SendNotification.hs
View File

@ -19,6 +19,7 @@ import Jobs.Handler.SendNotification.ExamResult
import Jobs.Handler.SendNotification.Allocation
import Jobs.Handler.SendNotification.ExamOffice
import Jobs.Handler.SendNotification.CourseRegistered
import Jobs.Handler.SendNotification.SubmissionEdited
dispatchJobSendNotification :: UserId -> Notification -> Handler ()

138
src/Jobs/Handler/SendNotification/SubmissionEdited.hs Normal file
View File

@ -0,0 +1,138 @@
{-# 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 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
addAlternatives $
providePreferredAlternative $(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
addAlternatives $
providePreferredAlternative $(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
addAlternatives $
providePreferredAlternative $(ihamletFile "templates/mail/submissionUserDeleted.hamlet")

5
src/Jobs/Queue.hs
View File

@ -2,7 +2,7 @@ module Jobs.Queue
( writeJobCtl, writeJobCtlBlock
, writeJobCtl', writeJobCtlBlock'
, queueJob, queueJob'
, YesodJobDB
, YesodJobDB, JobDB
, runDBJobs, queueDBJob, sinkDBJobs
, runDBJobs'
, queueDBJobCron
@ -113,6 +113,9 @@ queueJob' job = do
-- | Slightly modified Version of `YesodDB` for `runDBJobs`
type YesodJobDB site = ReaderT (YesodPersistBackend site) (WriterT (Set QueuedJobId) (HandlerFor site))
-- | Slightly modified Version of `DB` for `runDBJobs`
type JobDB = YesodJobDB UniWorX
queueDBJob, queueDBJobCron :: Job -> YesodJobDB UniWorX ()
-- | Queue a job as part of a database transaction and execute it after the transaction succeeds
queueDBJob job = mapReaderT lift (queueJobUnsafe False job) >>= tell . Set.singleton

3
src/Jobs/Types.hs
View File

@ -91,6 +91,9 @@ data Notification = NotificationSubmissionRated { nSubmission :: SubmissionId }
| NotificationExamOfficeExamResultsChanged { nExamResults :: Set ExamResultId }
| NotificationAllocationResults { nAllocation :: AllocationId }
| NotificationCourseRegistered { nUser :: UserId, nCourse :: CourseId }
| NotificationSubmissionEdited { nInitiator :: UserId, nSubmission :: SubmissionId }
| NotificationSubmissionUserCreated { nUser :: UserId, nSubmission :: SubmissionId }
| NotificationSubmissionUserDeleted { nUser :: UserId, nSheet :: SheetId, nSubmission :: SubmissionId }
deriving (Eq, Ord, Show, Read, Generic, Typeable)
instance Hashable Job

3
src/Model/Types/Mail.hs
View File

@ -24,6 +24,9 @@ import qualified Data.HashMap.Strict as HashMap
data NotificationTrigger
= NTSubmissionRatedGraded
| NTSubmissionRated
| NTSubmissionEdited
| NTSubmissionUserCreated
| NTSubmissionUserDeleted
| NTSheetActive
| NTSheetSoonInactive
| NTSheetInactive

6
templates/i18n/changelog/de-de-formal.hamlet
View File

@ -1,5 +1,11 @@
$newline never
<dl .deflist>
<dt .deflist__dt>
^{formatGregorianW 2019 12 05}
<dd .deflist__dd>
<ul>
<li>Benachrichtigungen bei Änderungen an Übungsblatt-Abgaben
<dt .deflist__dt>
^{formatGregorianW 2019 11 28}
<dd .deflist__dd>

6
templates/i18n/changelog/en-eu.hamlet
View File

@ -1,5 +1,11 @@
$newline never
<dl .deflist>
<dt .deflist__dt>
^{formatGregorianW 2019 12 05}
<dd .deflist__dd>
<ul>
<li>Notifications when exercise sheet submissions are changed
<dt .deflist__dt>
^{formatGregorianW 2019 11 28}
<dd .deflist__dd>

20
templates/mail/submissionEdited.hamlet Normal file
View File

@ -0,0 +1,20 @@
$newline never
\<!doctype html>
<html>
<head>
<meta charset="UTF-8">
<style>
h1 {
font-size: 1.25em;
font-variant: small-caps;
font-weight: normal;
}
<body>
<h1>
_{MsgMailSubmissionEditedIntro courseName sheetName termDesc (userDisplayName initiator)}
<p>
<a href=@{CSubmissionR tid ssh csh shn csid SubShowR}>
#{toPathPiece csid}
^{editNotifications}

23
templates/mail/submissionUserCreated.hamlet Normal file
View File

@ -0,0 +1,23 @@
$newline never
\<!doctype html>
<html>
<head>
<meta charset="UTF-8">
<style>
h1 {
font-size: 1.25em;
font-variant: small-caps;
font-weight: normal;
}
<body>
<h1>
$if isSelf
_{MsgMailSubmissionUserCreatedIntro courseName sheetName termDesc}
$else
_{MsgMailSubmissionUserCreatedOtherIntro userDisplayName courseName sheetName termDesc}
<p>
<a href=@{CSubmissionR tid ssh csh shn csid SubShowR}>
#{toPathPiece csid}
^{editNotifications}

24
templates/mail/submissionUserDeleted.hamlet Normal file
View File

@ -0,0 +1,24 @@
$newline never
\<!doctype html>
<html>
<head>
<meta charset="UTF-8">
<style>
h1 {
font-size: 1.25em;
font-variant: small-caps;
font-weight: normal;
}
<body>
<h1>
$if isSelf
_{MsgMailSubmissionUserDeletedIntro courseName sheetName termDesc}
$else
_{MsgMailSubmissionUserDeletedOtherIntro userDisplayName courseName sheetName termDesc}
$maybe csid' <- csid
<p>
<a href=@{CSubmissionR tid ssh csh shn csid' SubShowR}>
#{toPathPiece csid'}
^{editNotifications}