diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg index e747132b0..1f62998dc 100644 --- a/messages/uniworx/de.msg +++ b/messages/uniworx/de.msg @@ -342,6 +342,7 @@ AccessRightsFor: Berechtigungen für AdminFor: Administrator LecturerFor: Dozent LecturersFor: Dozenten +ForSchools n@Int: für #{pluralDE n "Institut" "Institute"} UserListTitle: Komprehensive Benutzerliste AccessRightsSaved: Berechtigungsänderungen wurden gespeichert. @@ -424,6 +425,12 @@ MailSheetInactiveIntro courseName@Text termDesc@Text sheetName@SheetName n@Int n MailSubjectCorrectionsAssigned csh@CourseShorthand sheetName@SheetName: Ihnen wurden Korrekturen zu #{sheetName} in #{csh} zugeteilt MailCorrectionsAssignedIntro courseName@Text termDesc@Text sheetName@SheetName n@Int: #{display n} #{pluralDE n "Abgabe wurde" "Abgaben wurden"} Ihnen zur Korrektur für #{sheetName} im Kurs #{courseName} (#{termDesc}) zugeteilt. +MailSubjectUserRightsUpdate name@Text: Berechtigungen für #{name} aktualisiert +MailUserRightsIntro name@Text email@UserEmail: #{name} <#{email}> hat folgende Uni2work Berechtigungen: +MailNoLecturerRights: Sie haben derzeit keine Dozenten-Rechte. +MailLecturerRights n@Int: Als Dozent dürfen Sie Veranstaltungen innerhalb #{pluralDE n "Ihres Instituts" "Ihrer Institute"} anlegen. + + MailEditNotifications: Benachrichtigungen ein-/ausschalten MailSubjectSupport: Supportanfrage @@ -472,6 +479,7 @@ NotificationTriggerSheetSoonInactive: Ich kann ein Übungsblatt bald nicht mehr NotificationTriggerSheetInactive: Abgabefrist eines meiner Übungsblätter ist abgelaufen NotificationTriggerCorrectionsAssigned: Mir wurden Abgaben zur Korrektur zugeteilt NotificationTriggerCorrectionsNotDistributed: Abgaben eines meiner Übungsblätter konnten keinem Korrektur zugeteilt werden +NotificationTriggerUserRightsUpdate: Meine Berechtigungen wurden geändert CorrCreate: Abgaben erstellen UnknownPseudonymWord pseudonymWord@Text: Unbekanntes Pseudonym-Wort "#{pseudonymWord}" diff --git a/src/Handler/Users.hs b/src/Handler/Users.hs index 7196055a9..9c482cf29 100644 --- a/src/Handler/Users.hs +++ b/src/Handler/Users.hs @@ -1,6 +1,8 @@ module Handler.Users where import Import + +import Jobs -- import Data.Text import Handler.Utils @@ -196,6 +198,7 @@ postAdminUserR uuid = do then void . insertUnique $ UserLecturer uid sid else deleteBy $ UniqueSchoolLecturer uid sid -- Note: deleteWhere would not work well here since we filter by adminSchools + queueJob' . JobQueueNotification $ NotificationUserRightsUpdate uid addMessageI Info MsgAccessRightsSaved ((result, formWidget),formEnctype) <- runFormPost userRightsForm formResult result userRightsAction diff --git a/src/Handler/Utils/Database.hs b/src/Handler/Utils/Database.hs new file mode 100644 index 000000000..386fe0983 --- /dev/null +++ b/src/Handler/Utils/Database.hs @@ -0,0 +1,31 @@ +module Handler.Utils.Database + ( getSchoolsOf + , makeSchoolDictionaryDB, makeSchoolDictionary + ) where + +import Import + +import Data.Map as Map +-- import Data.CaseInsensitive (CI) +-- import qualified Data.CaseInsensitive as CI + + +import qualified Database.Esqueleto as E + +makeSchoolDictionaryDB :: DB (Map.Map SchoolId SchoolName) +makeSchoolDictionaryDB = makeSchoolDictionary <$> selectList [] [Asc SchoolShorthand] + +makeSchoolDictionary :: [Entity School] -> Map.Map SchoolId SchoolName +makeSchoolDictionary schools = Map.fromDistinctAscList [ (ssh,schoolName) | Entity ssh School{schoolName} <- schools ] + +-- getSchoolsOf :: ( BaseBackend backend ~ SqlBackend +-- , PersistEntityBackend val ~ SqlBackend +-- , PersistUniqueRead backend, PersistQueryRead backend +-- , IsPersistBackend backend, PersistEntity val, MonadIO m) => +-- UserId -> EntityField val SchoolId -> EntityField val UserId -> ReaderT backend m [E.Value SchoolName] +getSchoolsOf :: (PersistEntity val, PersistEntityBackend val ~ SqlBackend) => UserId -> EntityField val SchoolId -> EntityField val UserId -> DB [SchoolName] +getSchoolsOf uid uschool uuser = fmap (Import.map E.unValue) $ E.select $ E.from $ \(urights `E.InnerJoin` school) -> do + E.on $ urights E.^. uschool E.==. school E.^. SchoolId + E.where_ $ urights E.^. uuser E.==. E.val uid + E.orderBy [E.asc $ school E.^.SchoolName] + return $ school E.^. SchoolName diff --git a/src/Jobs/Handler/QueueNotification.hs b/src/Jobs/Handler/QueueNotification.hs index 8c9a759a9..cf2c348de 100644 --- a/src/Jobs/Handler/QueueNotification.hs +++ b/src/Jobs/Handler/QueueNotification.hs @@ -20,7 +20,7 @@ dispatchJobQueueNotification jNotification = runDBJobs . setSerializable $ do guard $ notificationAllowed userNotificationSettings nClass return uid - + determineNotificationCandidates :: Notification -> DB [Entity User] determineNotificationCandidates NotificationSubmissionRated{..} = E.select . E.from $ \(user `E.InnerJoin` submissionUser) -> do @@ -40,20 +40,22 @@ determineNotificationCandidates NotificationSheetSoonInactive{..} E.where_ $ sheet E.^. SheetId E.==. E.val nSheet return user determineNotificationCandidates NotificationSheetInactive{..} - = E.select . E.from $ \(user `E.InnerJoin` lecturer `E.InnerJoin` sheet) -> do - E.on $ lecturer E.^. LecturerCourse E.==. sheet E.^. SheetCourse + = E.select . E.from $ \(user `E.InnerJoin` lecturer `E.InnerJoin` sheet) -> do + E.on $ lecturer E.^. LecturerCourse E.==. sheet E.^. SheetCourse E.on $ lecturer E.^. LecturerUser E.==. user E.^. UserId E.where_ $ sheet E.^. SheetId E.==. E.val nSheet return user determineNotificationCandidates NotificationCorrectionsAssigned{..} - = selectList [UserId ==. nUser] [] + = selectList [UserId ==. nUser] [] determineNotificationCandidates NotificationCorrectionsNotDistributed{nSheet} = E.select . E.from $ \(user `E.InnerJoin` lecturer `E.InnerJoin` sheet) -> do E.on $ lecturer E.^. LecturerCourse E.==. sheet E.^. SheetCourse E.on $ lecturer E.^. LecturerUser E.==. user E.^. UserId E.where_ $ sheet E.^. SheetId E.==. E.val nSheet return user - +determineNotificationCandidates NotificationUserRightsUpdate{..} + = selectList [UserId ==. nUser] [] + classifyNotification :: Notification -> DB NotificationTrigger classifyNotification NotificationSubmissionRated{..} = do Sheet{sheetType} <- belongsToJust submissionSheet =<< getJust nSubmission @@ -65,5 +67,6 @@ classifyNotification NotificationSheetSoonInactive{} = return NTSheetSoonInactiv classifyNotification NotificationSheetInactive{} = return NTSheetInactive classifyNotification NotificationCorrectionsAssigned{} = return NTCorrectionsAssigned classifyNotification NotificationCorrectionsNotDistributed{} = return NTCorrectionsNotDistributed +classifyNotification NotificationUserRightsUpdate{} = return NTUserRightsUpdate diff --git a/src/Jobs/Handler/SendNotification.hs b/src/Jobs/Handler/SendNotification.hs index 547830603..64921e118 100644 --- a/src/Jobs/Handler/SendNotification.hs +++ b/src/Jobs/Handler/SendNotification.hs @@ -12,6 +12,7 @@ import Jobs.Handler.SendNotification.SheetActive import Jobs.Handler.SendNotification.SheetInactive import Jobs.Handler.SendNotification.CorrectionsAssigned import Jobs.Handler.SendNotification.CorrectionsNotDistributed +import Jobs.Handler.SendNotification.UserRightsUpdate dispatchJobSendNotification :: UserId -> Notification -> Handler () diff --git a/src/Jobs/Handler/SendNotification/UserRightsUpdate.hs b/src/Jobs/Handler/SendNotification/UserRightsUpdate.hs new file mode 100644 index 000000000..3afd8ddc9 --- /dev/null +++ b/src/Jobs/Handler/SendNotification/UserRightsUpdate.hs @@ -0,0 +1,27 @@ +{-# OPTIONS_GHC -fno-warn-unused-do-bind #-} -- ihamletFile discards do results + +module Jobs.Handler.SendNotification.UserRightsUpdate + ( dispatchNotificationUserRightsUpdate + ) where + +import Import + +import Handler.Utils.Database +import Handler.Utils.Mail + +import Text.Hamlet +-- import qualified Data.CaseInsensitive as CI + +dispatchNotificationUserRightsUpdate :: UserId -> UserId -> Handler () +dispatchNotificationUserRightsUpdate nUser jRecipient = userMailT jRecipient $ do + (User{..}, adminSchools, lecturerSchools) <- liftHandlerT . runDB $ do + user <-getJust nUser + adminSchools <- getSchoolsOf nUser UserAdminSchool UserAdminUser + lecturerSchools <- getSchoolsOf nUser UserLecturerSchool UserLecturerUser + return (user,adminSchools,lecturerSchools) + setSubjectI $ MsgMailSubjectUserRightsUpdate userDisplayName + -- MsgRenderer mr <- getMailMsgRenderer + addAlternatives $ do + let editNotifications = $(ihamletFile "templates/mail/editNotifications.hamlet") + providePreferredAlternative ($(ihamletFile "templates/mail/userRightsUpdate.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX)) + diff --git a/src/Jobs/Types.hs b/src/Jobs/Types.hs index 2e6eb3164..492616d4f 100644 --- a/src/Jobs/Types.hs +++ b/src/Jobs/Types.hs @@ -18,7 +18,7 @@ data Job = JobSendNotification { jRecipient :: UserId, jNotification :: Notifica | JobHelpRequest { jSender :: Either (Maybe Address) UserId , jRequestTime :: UTCTime , jHelpRequest :: Text, jReferer :: Maybe Text } - | JobSetLogSettings { jInstance :: InstanceId, jLogSettings :: LogSettings } + | JobSetLogSettings { jInstance :: InstanceId, jLogSettings :: LogSettings } | JobDistributeCorrections { jSheet :: SheetId } deriving (Eq, Ord, Show, Read, Generic, Typeable) data Notification = NotificationSubmissionRated { nSubmission :: SubmissionId } @@ -27,6 +27,7 @@ data Notification = NotificationSubmissionRated { nSubmission :: SubmissionId } | NotificationSheetInactive { nSheet :: SheetId } | NotificationCorrectionsAssigned { nUser :: UserId, nSheet :: SheetId } | NotificationCorrectionsNotDistributed { nSheet :: SheetId } + | NotificationUserRightsUpdate { nUser :: UserId } -- User rights (admin, lecturer,...) were changed somehow deriving (Eq, Ord, Show, Read, Generic, Typeable) instance Hashable Job diff --git a/src/Model/Types.hs b/src/Model/Types.hs index dfedb2663..8af391c11 100644 --- a/src/Model/Types.hs +++ b/src/Model/Types.hs @@ -559,6 +559,7 @@ data NotificationTrigger = NTSubmissionRatedGraded | NTSheetInactive | NTCorrectionsAssigned | NTCorrectionsNotDistributed + | NTUserRightsUpdate deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable) instance Universe NotificationTrigger @@ -590,6 +591,7 @@ instance Default NotificationSettings where NTSheetInactive -> True NTCorrectionsAssigned -> True NTCorrectionsNotDistributed -> True + NTUserRightsUpdate -> True instance ToJSON NotificationSettings where toJSON v = toJSON . HashMap.fromList $ map (id &&& notificationAllowed v) universeF diff --git a/templates/mail/userRightsUpdate.hamlet b/templates/mail/userRightsUpdate.hamlet new file mode 100644 index 000000000..4aff0cab6 --- /dev/null +++ b/templates/mail/userRightsUpdate.hamlet @@ -0,0 +1,35 @@ +$newline never +\ + + + +