UserNotificationR

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

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

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

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

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

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

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

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

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

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

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

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

templates/mail/editNotifications.hamlet

@@ -1,4 +1,3 @@
 <p>      
-  <a href=@{ProfileR}>
-    _{MsgProfileHeading}
-  \ _{MsgMailEditNotifications}
+  <a href=#{editNotificationsUrl'}>
+    _{MsgMailEditNotifications}