From af6821c7c82966199c39b8a5f844331d809f4a80 Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Fri, 5 Apr 2019 15:23:10 +0200 Subject: [PATCH] UserNotificationR --- messages/uniworx/de.msg | 8 ++++- routes | 2 ++ src/Foundation.hs | 28 ++++++++++++++++- src/Handler/Profile.hs | 31 +++++++++++++++++-- src/Import.hs | 1 + .../SendNotification/CorrectionsAssigned.hs | 4 ++- .../Handler/SendNotification/SheetActive.hs | 4 ++- .../Handler/SendNotification/SheetInactive.hs | 7 +++-- .../SendNotification/SubmissionRated.hs | 4 ++- .../SendNotification/UserRightsUpdate.hs | 3 +- src/Jobs/Handler/SendNotification/Utils.hs | 20 ++++++++++++ src/Model/Types.hs | 1 + templates/mail/editNotifications.hamlet | 5 ++- 13 files changed, 105 insertions(+), 13 deletions(-) create mode 100644 src/Jobs/Handler/SendNotification/Utils.hs diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg index 3172caf4e..2e3b06abe 100644 --- a/messages/uniworx/de.msg +++ b/messages/uniworx/de.msg @@ -206,6 +206,7 @@ UnauthorizedOr l@Text r@Text: (#{l} ODER #{r}) UnauthorizedNoToken: Ihrer Anfrage war kein Authorisierungs-Token beigefügt. UnauthorizedTokenExpired: Ihr Authorisierungs-Token ist abgelaufen. UnauthorizedTokenNotStarted: Ihr Authorisierungs-Token ist noch nicht gültig. +UnauthorizedTokenInvalid: Ihr Authorisierungs-Token konnte nicht verarbeitet werden. UnauthorizedTokenInvalidRoute: Ihr Authorisierungs-Token ist auf dieser Unterseite nicht gültig. UnauthorizedSiteAdmin: Sie sind kein System-weiter Administrator. UnauthorizedSchoolAdmin: Sie sind nicht als Administrator für dieses Institut eingetragen. @@ -235,6 +236,7 @@ UnsupportedAuthPredicate authTagT@Text shownRoute@String: "#{authTagT}" wurde au UnauthorizedDisabledTag authTag@AuthTag: Authorisierungsprädikat "#{toPathPiece authTag}" ist für Ihre Sitzung nicht aktiv UnknownAuthPredicate tag@String: Authorisierungsprädikat "#{tag}" ist dem System nicht bekannt UnauthorizedRedirect: Die angeforderte Seite existiert nicht oder Sie haben keine Berechtigung, die angeforderte Seite zu sehen. +UnauthorizedSelf: Aktueller Nutzer ist nicht angegebener Benutzer. EMail: E-Mail EMailUnknown email@UserEmail: E-Mail #{email} gehört zu keinem bekannten Benutzer. @@ -276,6 +278,7 @@ ImpressumHeading: Impressum DataProtHeading: Datenschutzerklärung SystemMessageHeading: Uni2work Statusmeldung SystemMessageListHeading: Uni2work Statusmeldungen +NotificationSettingsHeading displayName@Text: Benachrichtigungs-Einstellungen für #{displayName} HomeOpenCourses: Kurse mit offener Registrierung HomeUpcomingSheets: Anstehende Übungsblätter @@ -292,7 +295,8 @@ Plugin: Plugin Ident: Identifikation LastLogin: Letzter Login Settings: Individuelle Benutzereinstellungen -SettingsUpdate: Einstellungen wurden gespeichert. +SettingsUpdate: Einstellungen erfolgreich gespeichert +NotificationSettingsUpdate: Benachrichtigungs-Einstellungen erfolgreich gespeichert Never: Nie MultiFileUploadInfo: (Mehrere Dateien mit Shift oder Strg auswählen) @@ -668,6 +672,7 @@ MenuCourseMembers: Kursteilnehmer MenuTermShow: Semester MenuSubmissionDelete: Abgabe löschen MenuUsers: Benutzer +MenuUserNotifications: Benachrichtigungs-Einstellungen MenuAdminTest: Admin-Demo MenuMessageList: Systemnachrichten MenuAdminErrMsg: Fehlermeldung entschlüsseln @@ -718,6 +723,7 @@ AuthTagOwner: Nutzer ist Besitzer AuthTagRated: Korrektur ist bewertet AuthTagUserSubmissions: Abgaben erfolgen durch Kursteilnehmer AuthTagCorrectorSubmissions: Abgaben erfolgen durch Korrektoren +AuthTagSelf: Nutzer greift nur auf eigene Daten zu AuthTagAuthentication: Nutzer ist angemeldet, falls erforderlich AuthTagRead: Zugriff ist nur lesend AuthTagWrite: Zugriff ist i.A. schreibend diff --git a/routes b/routes index f76fd47b7..24ce58838 100644 --- a/routes +++ b/routes @@ -16,6 +16,7 @@ -- !registered -- participant for this course (no effect outside of courses) -- !participant -- connected with a given course (not necessarily registered), i.e. has a submission, is a corrector, etc. (no effect outside of courses) -- !owner -- part of the group of owners of this submission +-- !self -- route refers to the currently logged in user themselves -- !capacity -- course this route is associated with has at least one unit of participant capacity -- !empty -- course this route is associated with has no participants whatsoever -- @@ -39,6 +40,7 @@ /users/#CryptoUUIDUser AdminUserR GET POST /users/#CryptoUUIDUser/delete AdminUserDeleteR POST /users/#CryptoUUIDUser/hijack AdminHijackUserR POST !adminANDno-escalation +/users/#CryptoUUIDUser/notifications UserNotificationR GET POST !self /admin AdminR GET /admin/features AdminFeaturesR GET POST /admin/test AdminTestR GET POST diff --git a/src/Foundation.hs b/src/Foundation.hs index 9634fda67..533804953 100644 --- a/src/Foundation.hs +++ b/src/Foundation.hs @@ -482,7 +482,9 @@ tagAccessPredicate AuthToken = APDB $ \mAuthId route isWrite -> exceptT return r BearerToken{..} <- catch (decodeToken jwt) $ \case BearerTokenExpired -> throwError =<< unauthorizedI MsgUnauthorizedTokenExpired BearerTokenNotStarted -> throwError =<< unauthorizedI MsgUnauthorizedTokenNotStarted - other -> throwM other + other -> do + $logWarnS "AuthToken" $ tshow other + throwError =<< unauthorizedI MsgUnauthorizedTokenInvalid unless (maybe True (HashSet.member route) tokenRoutes) $ throwError =<< unauthorizedI MsgUnauthorizedTokenInvalidRoute authorityVal <- evalAccessFor (Just tokenAuthority) route isWrite @@ -735,6 +737,20 @@ tagAccessPredicate AuthCorrectorSubmissions = APDB $ \_ route _ -> case route of guard $ sheetSubmissionMode == CorrectorSubmissions return Authorized r -> $unsupportedAuthPredicate AuthCorrectorSubmissions r +tagAccessPredicate AuthSelf = APHandler $ \mAuthId route _ -> exceptT return return $ do + referencedUser <- case route of + AdminUserR cID -> return cID + AdminUserDeleteR cID -> return cID + AdminHijackUserR cID -> return cID + UserNotificationR cID -> return cID + CourseR _ _ _ (CUserR cID) -> return cID + _other -> throwError =<< $unsupportedAuthPredicate AuthSelf route + referencedUser' <- decrypt referencedUser + case mAuthId of + Just uid + | uid == referencedUser' -> return Authorized + Nothing -> return AuthenticationRequired + _other -> unauthorizedI MsgUnauthorizedSelf tagAccessPredicate AuthAuthentication = APDB $ \mAuthId route _ -> case route of MessageR cID -> maybeT (unauthorizedI MsgUnauthorizedSystemMessageAuth) $ do smId <- decrypt cID @@ -1465,6 +1481,16 @@ pageActions (AdminR) = , menuItemAccessCallback' = return True } ] +pageActions (AdminUserR cID) = [ + MenuItem + { menuItemType = PageActionPrime + , menuItemLabel = MsgMenuUserNotifications + , menuItemIcon = Nothing + , menuItemRoute = SomeRoute $ UserNotificationR cID + , menuItemModal = True + , menuItemAccessCallback' = return True + } + ] pageActions (InfoR) = [ MenuItem { menuItemType = PageActionPrime diff --git a/src/Handler/Profile.hs b/src/Handler/Profile.hs index 5de418a34..326beb0d6 100644 --- a/src/Handler/Profile.hs +++ b/src/Handler/Profile.hs @@ -42,11 +42,10 @@ makeSettingForm template = identifyForm FIDsettings $ \html -> do & setTooltip MsgDownloadFilesTip ) (stgDownloadFiles <$> template) <* aformSection MsgFormNotifications - <*> (NotificationSettings <$> funcForm nsForm (fslI MsgNotificationSettings) True) + <*> notificationForm (stgNotificationSettings <$> template) return (result, widget) -- no validation required here where themeList = [Option (display t) t (toPathPiece t) | t <- universeF] - nsForm nt = fromMaybe False <$> aopt checkBoxField (fslI nt) (Just $ flip notificationAllowed nt . stgNotificationSettings <$> template) -- -- Version with proper grouping: -- @@ -76,6 +75,12 @@ makeSettingForm template = identifyForm FIDsettings $ \html -> do -- <*> (NotificationSettings <$> funcForm nsForm (fslI MsgNotificationSettings) True) -- nsForm nt = fromMaybe False <$> aopt checkBoxField (fslI nt) (Just $ flip notificationAllowed nt . stgNotificationSettings <$> template) +notificationForm :: Maybe NotificationSettings -> AForm Handler NotificationSettings +notificationForm template = NotificationSettings <$> funcForm nsForm (fslI MsgNotificationSettings) True + where + nsForm nt = fromMaybe False <$> aopt checkBoxField (fslI nt) (Just $ flip notificationAllowed nt <$> template) + + getProfileR, postProfileR :: Handler Html getProfileR = postProfileR postProfileR = do @@ -532,3 +537,25 @@ postAuthPredsR = do siteLayoutMsg MsgAuthPredsActive $ do setTitleI MsgAuthPredsActive $(widgetFile "authpreds") + + +getUserNotificationR, postUserNotificationR :: CryptoUUIDUser -> Handler Html +getUserNotificationR = postUserNotificationR +postUserNotificationR cID = do + uid <- decrypt cID + User{userNotificationSettings, userDisplayName} <- runDB $ get404 uid + + ((nsRes, nsInnerWdgt), nsEnc) <- runFormPost . renderAForm FormStandard . notificationForm $ Just userNotificationSettings + isModal <- hasCustomHeader HeaderIsModal + let formWidget = wrapForm nsInnerWdgt def + { formAction = Just . SomeRoute $ UserNotificationR cID + , formEncoding = nsEnc + , formAttrs = [ ("data-ajax-submit", "") | isModal ] + } + + formResultModal nsRes (UserNotificationR cID) $ \ns -> do + lift . runDB $ update uid [ UserNotificationSettings =. ns ] + tell . pure =<< messageI Success MsgNotificationSettingsUpdate + + siteLayoutMsg (MsgNotificationSettingsHeading userDisplayName) $ + formWidget diff --git a/src/Import.hs b/src/Import.hs index 27dc6e5df..9743e86ac 100644 --- a/src/Import.hs +++ b/src/Import.hs @@ -6,3 +6,4 @@ import Foundation as Import import Import.NoFoundation as Import import Utils.SystemMessage as Import +import Model.Token as Import diff --git a/src/Jobs/Handler/SendNotification/CorrectionsAssigned.hs b/src/Jobs/Handler/SendNotification/CorrectionsAssigned.hs index 51ec02f77..f7943cb6c 100644 --- a/src/Jobs/Handler/SendNotification/CorrectionsAssigned.hs +++ b/src/Jobs/Handler/SendNotification/CorrectionsAssigned.hs @@ -6,6 +6,7 @@ module Jobs.Handler.SendNotification.CorrectionsAssigned import Import +import Jobs.Handler.SendNotification.Utils import Handler.Utils.Mail import Text.Hamlet @@ -27,6 +28,7 @@ dispatchNotificationCorrectionsAssigned nUser nSheet jRecipient = do MsgRenderer mr <- getMailMsgRenderer let termDesc = mr . ShortTermIdentifier $ unTermKey courseTerm + editNotifications <- mkEditNotifications jRecipient + addAlternatives $ do - let editNotifications = $(ihamletFile "templates/mail/editNotifications.hamlet") providePreferredAlternative ($(ihamletFile "templates/mail/correctionsAssigned.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX)) diff --git a/src/Jobs/Handler/SendNotification/SheetActive.hs b/src/Jobs/Handler/SendNotification/SheetActive.hs index 91a8fc716..6e3618de2 100644 --- a/src/Jobs/Handler/SendNotification/SheetActive.hs +++ b/src/Jobs/Handler/SendNotification/SheetActive.hs @@ -7,6 +7,7 @@ module Jobs.Handler.SendNotification.SheetActive import Import import Handler.Utils.Mail +import Jobs.Handler.SendNotification.Utils import Text.Hamlet import qualified Data.CaseInsensitive as CI @@ -26,6 +27,7 @@ dispatchNotificationSheetActive nSheet jRecipient = userMailT jRecipient $ do csh = courseShorthand shn = sheetName + editNotifications <- mkEditNotifications jRecipient + addAlternatives $ do - let editNotifications = $(ihamletFile "templates/mail/editNotifications.hamlet") providePreferredAlternative ($(ihamletFile "templates/mail/sheetActive.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX)) diff --git a/src/Jobs/Handler/SendNotification/SheetInactive.hs b/src/Jobs/Handler/SendNotification/SheetInactive.hs index 7112e5c39..bab937c89 100644 --- a/src/Jobs/Handler/SendNotification/SheetInactive.hs +++ b/src/Jobs/Handler/SendNotification/SheetInactive.hs @@ -8,6 +8,7 @@ module Jobs.Handler.SendNotification.SheetInactive import Import import Handler.Utils.Mail +import Jobs.Handler.SendNotification.Utils import Text.Hamlet import qualified Data.CaseInsensitive as CI @@ -29,8 +30,9 @@ dispatchNotificationSheetSoonInactive nSheet jRecipient = userMailT jRecipient $ csh = courseShorthand shn = sheetName + editNotifications <- mkEditNotifications jRecipient + addAlternatives $ do - let editNotifications = $(ihamletFile "templates/mail/editNotifications.hamlet") providePreferredAlternative ($(ihamletFile "templates/mail/sheetSoonInactive.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX)) dispatchNotificationSheetInactive :: SheetId -> UserId -> Handler () @@ -54,7 +56,8 @@ dispatchNotificationSheetInactive nSheet jRecipient = userMailT jRecipient $ do csh = courseShorthand shn = sheetName + editNotifications <- mkEditNotifications jRecipient + addAlternatives $ do - let editNotifications = $(ihamletFile "templates/mail/editNotifications.hamlet") providePreferredAlternative ($(ihamletFile "templates/mail/sheetInactive.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX)) diff --git a/src/Jobs/Handler/SendNotification/SubmissionRated.hs b/src/Jobs/Handler/SendNotification/SubmissionRated.hs index 78083d83f..16423a924 100644 --- a/src/Jobs/Handler/SendNotification/SubmissionRated.hs +++ b/src/Jobs/Handler/SendNotification/SubmissionRated.hs @@ -9,6 +9,7 @@ import Import import Utils.Lens import Handler.Utils.DateTime import Handler.Utils.Mail +import Jobs.Handler.SendNotification.Utils import Text.Hamlet import qualified Data.Aeson as Aeson @@ -34,6 +35,8 @@ dispatchNotificationSubmissionRated nSubmission jRecipient = userMailT jRecipien csh = courseShorthand shn = sheetName + editNotifications <- mkEditNotifications jRecipient + -- TODO: provide convienience template-haskell for `addAlternatives` addAlternatives $ do provideAlternative $ Aeson.object @@ -51,5 +54,4 @@ dispatchNotificationSubmissionRated nSubmission jRecipient = userMailT jRecipien , "course-school" Aeson..= courseSchool ] -- provideAlternative $ \(MsgRenderer mr) -> ($(textFile "templates/mail/submissionRated.txt") :: TextUrl (Route UniWorX)) -- textFile does not support control statements - let editNotifications = $(ihamletFile "templates/mail/editNotifications.hamlet") providePreferredAlternative ($(ihamletFile "templates/mail/submissionRated.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX)) diff --git a/src/Jobs/Handler/SendNotification/UserRightsUpdate.hs b/src/Jobs/Handler/SendNotification/UserRightsUpdate.hs index aaf50ac72..90e645de7 100644 --- a/src/Jobs/Handler/SendNotification/UserRightsUpdate.hs +++ b/src/Jobs/Handler/SendNotification/UserRightsUpdate.hs @@ -8,6 +8,7 @@ import Import import Handler.Utils.Database import Handler.Utils.Mail +import Jobs.Handler.SendNotification.Utils import Text.Hamlet -- import qualified Data.CaseInsensitive as CI @@ -21,7 +22,7 @@ dispatchNotificationUserRightsUpdate nUser _originalRights jRecipient = userMai return (user,adminSchools,lecturerSchools) setSubjectI $ MsgMailSubjectUserRightsUpdate userDisplayName -- MsgRenderer mr <- getMailMsgRenderer + editNotifications <- mkEditNotifications jRecipient addAlternatives $ do - let editNotifications = $(ihamletFile "templates/mail/editNotifications.hamlet") providePreferredAlternative ($(ihamletFile "templates/mail/userRightsUpdate.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX)) diff --git a/src/Jobs/Handler/SendNotification/Utils.hs b/src/Jobs/Handler/SendNotification/Utils.hs new file mode 100644 index 000000000..d7ca82a76 --- /dev/null +++ b/src/Jobs/Handler/SendNotification/Utils.hs @@ -0,0 +1,20 @@ +module Jobs.Handler.SendNotification.Utils + ( mkEditNotifications + ) where + +import Import + +import Text.Hamlet + +import qualified Data.HashSet as HashSet + + +mkEditNotifications :: (MonadHandler m, HandlerSite m ~ UniWorX) => UserId -> m (HtmlUrlI18n UniWorXMessage (Route UniWorX)) +mkEditNotifications uid = liftHandlerT $ do + cID <- encrypt uid + jwt <- encodeToken =<< bearerToken uid (Just . HashSet.singleton $ UserNotificationR cID) Nothing Nothing Nothing + let + editNotificationsUrl :: SomeRoute UniWorX + editNotificationsUrl = SomeRoute (UserNotificationR cID, [(toPathPiece GetToken, toPathPiece jwt)]) + editNotificationsUrl' <- toTextUrl editNotificationsUrl + return ($(ihamletFile "templates/mail/editNotifications.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX)) diff --git a/src/Model/Types.hs b/src/Model/Types.hs index 0c3fb1198..21672d9d2 100644 --- a/src/Model/Types.hs +++ b/src/Model/Types.hs @@ -727,6 +727,7 @@ data AuthTag -- sortiert nach gewünschter Reihenfolge auf /authpreds, d.h. Prä | AuthCorrectorSubmissions | AuthCapacity | AuthEmpty + | AuthSelf | AuthAuthentication | AuthNoEscalation | AuthRead diff --git a/templates/mail/editNotifications.hamlet b/templates/mail/editNotifications.hamlet index 7ca5d9f8b..6e701e511 100644 --- a/templates/mail/editNotifications.hamlet +++ b/templates/mail/editNotifications.hamlet @@ -1,4 +1,3 @@

- - _{MsgProfileHeading} - \ _{MsgMailEditNotifications} \ No newline at end of file + + _{MsgMailEditNotifications}