NotficationUserRightsUpdate added

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}"

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

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

src/Jobs/Handler/QueueNotification.hs

@@ -53,6 +53,8 @@ determineNotificationCandidates NotificationCorrectionsNotDistributed{nSheet}
       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
@@ -65,5 +67,6 @@ classifyNotification NotificationSheetSoonInactive{} = return NTSheetSoonInactiv
 classifyNotification NotificationSheetInactive{} = return NTSheetInactive
 classifyNotification NotificationCorrectionsAssigned{} = return NTCorrectionsAssigned
 classifyNotification NotificationCorrectionsNotDistributed{} = return NTCorrectionsNotDistributed
+classifyNotification NotificationUserRightsUpdate{} = return NTUserRightsUpdate
 
 

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 ()

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))
+

src/Jobs/Types.hs

@@ -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

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

templates/mail/userRightsUpdate.hamlet

@@ -0,0 +1,35 @@
+$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>
+      _{MsgMailUserRightsIntro userDisplayName userEmail}
+    $with numSchools <- length adminSchools
+      $if numSchools > 0
+        <p>
+          <h2>_{MsgAdminFor} _{MsgForSchools numSchools}
+          <ul>
+            $forall sn <- adminSchools
+              <li>#{sn}
+    $with numSchools <- length lecturerSchools
+      $if numSchools > 0
+        <p>
+          <h2>_{MsgLecturerFor} _{MsgForSchools numSchools}
+          <ul>
+            $forall sn <- lecturerSchools
+              <li>#{sn}
+        <p>
+          <a href=@{CourseNewR}>
+            _{MsgMailLecturerRights numSchools}
+      $else
+        <p>_{MsgMailNoLecturerRights}
+
+    ^{editNotifications}

templates/widgets/footer.hamlet

@@ -8,5 +8,5 @@
           $#   menuItemModal :: Bool -- ^ Should this menu item open a modal instead of being a normal link
           $#   menuItemIcon :: Maybe Text -- ^ Should this menu item have an icon, if yes, then the name of the icon
           <a href=#{route} ##{menuIdent}>
-            _{SomeMessage menuItemLabel} #
+            _{SomeMessage menuItemLabel}
         $of _