From 972bc11d46cd5a16fea77d8b8bad1a0c30873a09 Mon Sep 17 00:00:00 2001 From: SJost Date: Thu, 21 Feb 2019 11:15:02 +0100 Subject: [PATCH] new admin notfifications are sent to fellow school admins as well now --- models/schools | 4 ++-- src/Database/Esqueleto/Utils.hs | 10 ++++++---- src/Handler/Users.hs | 7 ++++--- src/Jobs/Handler/QueueNotification.hs | 18 ++++++++++++++++-- .../SendNotification/UserRightsUpdate.hs | 4 ++-- src/Jobs/Types.hs | 2 +- src/Model/Types.hs | 1 - 7 files changed, 31 insertions(+), 15 deletions(-) diff --git a/models/schools b/models/schools index 625235f2f..6b73e1c27 100644 --- a/models/schools +++ b/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 diff --git a/src/Database/Esqueleto/Utils.hs b/src/Database/Esqueleto/Utils.hs index 443af5517..9e78f9fd0 100644 --- a/src/Database/Esqueleto/Utils.hs +++ b/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 diff --git a/src/Handler/Users.hs b/src/Handler/Users.hs index a61c4dda9..3fa72341f 100644 --- a/src/Handler/Users.hs +++ b/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 diff --git a/src/Jobs/Handler/QueueNotification.hs b/src/Jobs/Handler/QueueNotification.hs index cf2c348de..5dfdc20fa 100644 --- a/src/Jobs/Handler/QueueNotification.hs +++ b/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 diff --git a/src/Jobs/Handler/SendNotification/UserRightsUpdate.hs b/src/Jobs/Handler/SendNotification/UserRightsUpdate.hs index 3afd8ddc9..aaf50ac72 100644 --- a/src/Jobs/Handler/SendNotification/UserRightsUpdate.hs +++ b/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 nUser jRecipient = userMailT jRecipient $ do +dispatchNotificationUserRightsUpdate :: UserId -> [(SchoolShorthand,Bool,Bool)]-> UserId -> Handler () +dispatchNotificationUserRightsUpdate nUser _originalRights jRecipient = userMailT jRecipient $ do (User{..}, adminSchools, lecturerSchools) <- liftHandlerT . runDB $ do user <-getJust nUser adminSchools <- getSchoolsOf nUser UserAdminSchool UserAdminUser diff --git a/src/Jobs/Types.hs b/src/Jobs/Types.hs index 492616d4f..151d0e404 100644 --- a/src/Jobs/Types.hs +++ b/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 diff --git a/src/Model/Types.hs b/src/Model/Types.hs index 8af391c11..94655817d 100644 --- a/src/Model/Types.hs +++ b/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