new admin notfifications are sent to fellow school admins as well now

models/schools

@@ -1,7 +1,7 @@
 School json
     name          (CI Text)
-    shorthand     (CI Text)
+    shorthand     (CI Text)  -- SchoolKey :: SchoolShorthand -> SchoolId
     UniqueSchool name
     UniqueSchoolShorthand shorthand -- required for Normalisation of CI Text
-    Primary shorthand  -- newtype Key School = SchoolKey { unSchoolKey :: SchoolShorthand }
+    Primary shorthand        -- newtype Key School = SchoolKey { unSchoolKey :: SchoolShorthand }
     deriving Eq Show Generic

src/Database/Esqueleto/Utils.hs

@@ -1,14 +1,16 @@
 module Database.Esqueleto.Utils where
 
--- | Convenience for using Esqueleto,
---   intended to be imported qualified
---   just like Esqueleto
-
 import ClassyPrelude.Yesod hiding (isInfixOf, (||.))
 import Data.Foldable as F
 import Database.Esqueleto as E
 
 
+{-|
+  Description : Convenience for using @Esqueleto@,
+                intended to be imported qualified
+                just like Esqueleto
+-}
+
 -- ezero = E.val (0 :: Int64)
 
 -- | Often needed with this concrete type

src/Handler/Users.hs

@@ -156,7 +156,8 @@ postAdminUserR uuid = do
     adminId <- requireAuthId
     uid <- decrypt uuid
     let fromSchoolList = Set.fromList . map (userAdminSchool . entityVal)
-    (User{..}, fromSchoolList -> adminSchools, userRights) <- runDB $ (,,)
+    let unValueRights (school, E.Value isAdmin, E.Value isLecturer) = (school,isAdmin,isLecturer)
+    (User{..}, fromSchoolList -> adminSchools, fmap unValueRights -> userRights) <- runDB $ (,,)
         <$> get404 uid
         <*> selectList [UserAdminUser ==. adminId] []
         <*> E.select ( E.from $ \school -> do
@@ -172,7 +173,7 @@ postAdminUserR uuid = do
     -- above data is needed for both form generation and result evaluation
     let userRightsForm :: Form [(SchoolId, Bool, Bool)]
         userRightsForm csrf = do
-          boxRights <- forM userRights $ \(school@(Entity sid _), E.Value isAdmin, E.Value isLecturer) ->
+          boxRights <- forM userRights $ \(school@(Entity sid _), isAdmin, isLecturer) ->
             if Set.member sid adminSchools
               then do
                 cbAdmin    <- mreq    checkBoxField "" (Just isAdmin)
@@ -198,7 +199,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
+          queueJob' . JobQueueNotification $ NotificationUserRightsUpdate uid (over _1 (schoolShorthand . entityVal) <$> userRights) -- original rights to check for difference
           addMessageI Info MsgAccessRightsSaved
     ((result, formWidget),formEnctype) <- runFormPost userRightsForm
     formResult result userRightsAction

src/Jobs/Handler/QueueNotification.hs

@@ -2,7 +2,9 @@ module Jobs.Handler.QueueNotification
   ( dispatchJobQueueNotification
   ) where
 
-import Import
+import Import hiding ((\\))
+
+import Data.List ((\\))
 
 import Jobs.Types
 
@@ -54,7 +56,19 @@ determineNotificationCandidates NotificationCorrectionsNotDistributed{nSheet}
       E.where_ $ sheet E.^. SheetId E.==. E.val nSheet
       return user
 determineNotificationCandidates NotificationUserRightsUpdate{..}
-  = selectList [UserId ==. nUser] []
+  = do
+      -- always send to affected user
+      affectedUser <- selectList [UserId ==. nUser] []
+      -- send to same-school admins only if there was an update
+      currentAdminSchools <- fmap (userAdminSchool . entityVal) <$> selectList [UserAdminUser ==. nUser] []
+      let oldAdminSchools = [ SchoolKey ssh | (ssh, True, _) <- originalRights ]
+          newAdminSchools = currentAdminSchools \\ oldAdminSchools
+      affectedAdmins <- E.select . E.from $ \(user `E.InnerJoin` admin) -> do
+        E.on $ admin E.^. UserAdminUser E.==. user E.^. UserId
+        E.where_ $ admin E.^. UserAdminSchool `E.in_` E.valList newAdminSchools
+        return user
+      return $ affectedUser <> affectedAdmins
+
 
 classifyNotification :: Notification -> DB NotificationTrigger
 classifyNotification NotificationSubmissionRated{..} = do

src/Jobs/Handler/SendNotification/UserRightsUpdate.hs

@@ -12,8 +12,8 @@ import Handler.Utils.Mail
 import Text.Hamlet
 -- import qualified Data.CaseInsensitive as CI
 
-dispatchNotificationUserRightsUpdate :: UserId -> UserId -> Handler ()
+dispatchNotificationUserRightsUpdate :: UserId -> [(SchoolShorthand,Bool,Bool)]-> UserId -> Handler ()
-dispatchNotificationUserRightsUpdate  nUser jRecipient = userMailT jRecipient $ do
+dispatchNotificationUserRightsUpdate  nUser _originalRights jRecipient = userMailT jRecipient $ do
     (User{..}, adminSchools, lecturerSchools)  <-  liftHandlerT . runDB $ do
       user <-getJust nUser
       adminSchools    <- getSchoolsOf nUser UserAdminSchool    UserAdminUser

src/Jobs/Types.hs

@@ -27,7 +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
+                  | NotificationUserRightsUpdate { nUser :: UserId, originalRights :: [(SchoolShorthand,Bool,Bool)] } -- User rights (admin, lecturer,...) were changed somehow
   deriving (Eq, Ord, Show, Read, Generic, Typeable)
 
 instance Hashable Job

src/Model/Types.hs

@@ -609,7 +609,6 @@ derivePersistFieldJSON ''NotificationSettings
 instance ToBackendKey SqlBackend record => Hashable (Key record) where
   hashWithSalt s key = s `hashWithSalt` fromSqlKey key
 
-
 derivePersistFieldJSON ''MailLanguages