diff --git a/messages/uniworx/de-de-formal.msg b/messages/uniworx/de-de-formal.msg index 9c706791d..07ecf66f7 100644 --- a/messages/uniworx/de-de-formal.msg +++ b/messages/uniworx/de-de-formal.msg @@ -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}" diff --git a/messages/uniworx/en-eu.msg b/messages/uniworx/en-eu.msg index b7708491a..3c8a5716b 100644 --- a/messages/uniworx/en-eu.msg +++ b/messages/uniworx/en-eu.msg @@ -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 diff --git a/src/Handler/Corrections.hs b/src/Handler/Corrections.hs index 8e126e2bb..df5aad3eb 100644 --- a/src/Handler/Corrections.hs +++ b/src/Handler/Corrections.hs @@ -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')}|] diff --git a/src/Handler/Course/Events/Delete.hs b/src/Handler/Course/Events/Delete.hs index 794bc0a69..609fa93a5 100644 --- a/src/Handler/Course/Events/Delete.hs +++ b/src/Handler/Course/Events/Delete.hs @@ -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{..} diff --git a/src/Handler/Course/News/Delete.hs b/src/Handler/Course/News/Delete.hs index 1b2155ee7..2311f9335 100644 --- a/src/Handler/Course/News/Delete.hs +++ b/src/Handler/Course/News/Delete.hs @@ -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{..} diff --git a/src/Handler/Profile.hs b/src/Handler/Profile.hs index 55e2c51f8..c13c3f13f 100644 --- a/src/Handler/Profile.hs +++ b/src/Handler/Profile.hs @@ -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 diff --git a/src/Handler/Submission.hs b/src/Handler/Submission.hs index ccf3b8242..f0754e210 100644 --- a/src/Handler/Submission.hs +++ b/src/Handler/Submission.hs @@ -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 diff --git a/src/Handler/Utils/Delete.hs b/src/Handler/Utils/Delete.hs index c77d5a10a..d91d9a3fc 100644 --- a/src/Handler/Utils/Delete.hs +++ b/src/Handler/Utils/Delete.hs @@ -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 diff --git a/src/Handler/Utils/Submission.hs b/src/Handler/Utils/Submission.hs index 080e7f684..23d9aed0b 100644 --- a/src/Handler/Utils/Submission.hs +++ b/src/Handler/Utils/Submission.hs @@ -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 } diff --git a/src/Jobs/Handler/QueueNotification.hs b/src/Jobs/Handler/QueueNotification.hs index b38c0dcb2..6a7b36fcb 100644 --- a/src/Jobs/Handler/QueueNotification.hs +++ b/src/Jobs/Handler/QueueNotification.hs @@ -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 diff --git a/src/Jobs/Handler/SendNotification.hs b/src/Jobs/Handler/SendNotification.hs index d31833fbd..cec2387bd 100644 --- a/src/Jobs/Handler/SendNotification.hs +++ b/src/Jobs/Handler/SendNotification.hs @@ -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 () diff --git a/src/Jobs/Handler/SendNotification/SubmissionEdited.hs b/src/Jobs/Handler/SendNotification/SubmissionEdited.hs new file mode 100644 index 000000000..1364b460b --- /dev/null +++ b/src/Jobs/Handler/SendNotification/SubmissionEdited.hs @@ -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") diff --git a/src/Jobs/Queue.hs b/src/Jobs/Queue.hs index 28deae9af..c85ba0d9d 100644 --- a/src/Jobs/Queue.hs +++ b/src/Jobs/Queue.hs @@ -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 diff --git a/src/Jobs/Types.hs b/src/Jobs/Types.hs index 058aa0219..b23a68c0d 100644 --- a/src/Jobs/Types.hs +++ b/src/Jobs/Types.hs @@ -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 diff --git a/src/Model/Types/Mail.hs b/src/Model/Types/Mail.hs index c626bad7b..de71b226b 100644 --- a/src/Model/Types/Mail.hs +++ b/src/Model/Types/Mail.hs @@ -24,6 +24,9 @@ import qualified Data.HashMap.Strict as HashMap data NotificationTrigger = NTSubmissionRatedGraded | NTSubmissionRated + | NTSubmissionEdited + | NTSubmissionUserCreated + | NTSubmissionUserDeleted | NTSheetActive | NTSheetSoonInactive | NTSheetInactive diff --git a/templates/i18n/changelog/de-de-formal.hamlet b/templates/i18n/changelog/de-de-formal.hamlet index 9fb651ff2..ad97f3dae 100644 --- a/templates/i18n/changelog/de-de-formal.hamlet +++ b/templates/i18n/changelog/de-de-formal.hamlet @@ -1,5 +1,11 @@ $newline never
+
+ ^{formatGregorianW 2019 12 05} +
+