diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg index 551a21067..968fb84c9 100644 --- a/messages/uniworx/de.msg +++ b/messages/uniworx/de.msg @@ -1596,6 +1596,10 @@ UserDisplayNameRules: Vorgaben für den angezeigten Namen UserDisplayNameRulesBelow: Vorgaben für den angezeigten Namen finden sich weiter unten auf der Seite UserMatriculation: Matrikelnummer +UserDisplayEmail: Angezeigte E-Mail Adresse +UserDisplayEmailTip: Diese Adresse wird in öffentlich zugänglichen Teilen des Systems im Zusammenhang mit Ihrem Namen angezeigt. Benachrichtigungen und andere Kommunikation von Uni2work und Nutzern mit erweiterten Rechten erhalten sie stets, unabhängig von dieser Einstellung, an die in Ihren Persönlichen Daten hinterlegte primäre Adresse. +UserDisplayEmailChangeSent displayEmail@UserEmail: Anweisungen zum Ändern der angezeigten E-Mail Adresse wurden an „#{displayEmail}” versandt + SchoolShort: Kürzel SchoolName: Name SchoolLdapOrganisations: Assoziierte LDAP-Fragmente @@ -1643,6 +1647,7 @@ AdminUserFirstName: Vorname AdminUserSurname: Nachname AdminUserDisplayName: Anzeige-Name AdminUserEmail: E-Mail Addresse +AdminUserDisplayEmail: Anzeige-E-Mail AdminUserIdent: Identifikation AdminUserAuth: Authentifizierung AdminUserMatriculation: Matrikelnummer @@ -1655,4 +1660,12 @@ CourseAllocationsBounds n@Int: Voraussichtliche Zuteilungen durch #{pluralDE n " CourseAllocationsBoundCoincide numFirstChoice@Int: Vstl. #{numFirstChoice} Teilnehmer CourseAllocationsBound numApps@Int numFirstChoice@Int: Vstl. zwischen #{numFirstChoice} und #{numApps} Teilnehmer CourseAllocationsBoundCapped: Die obige Anzeige wurde durch die aktuell angegebene Kurskapazität reduziert. -CourseAllocationsBoundWarningOpen: Diese Informationen entsprechen nur dem aktuellen Stand der Bewerbungen und können sich noch ändern. \ No newline at end of file +CourseAllocationsBoundWarningOpen: Diese Informationen entsprechen nur dem aktuellen Stand der Bewerbungen und können sich noch ändern. + +BtnSetDisplayEmail: E-Mail Adresse setzen +UserDisplayEmailChanged: Öffentliche E-Mail Adresse erfolgreich gesetzt +TitleChangeUserDisplayEmail: Öffentliche E-Mail Adresse setzen + +MailSubjectChangeUserDisplayEmail: Diese E-Mail Adresse in Uni2work veröffentlichen +MailIntroChangeUserDisplayEmail displayEmail@UserEmail: Der oben genannte Benutzer möchte „#{displayEmail}“ als öffentliche Adresse, assoziiert mit sich selbst, angeben. Wenn Sie diese Aktion nicht selbst ausgelöst haben, ignorieren Sie diese Mitteilung bitte! +MailTitleChangeUserDisplayEmail displayName@Text: #{displayName} möchte diese E-Mail Adresse in Uni2work veröffentlichen \ No newline at end of file diff --git a/models/users b/models/users index b7e24447e..22c14f1dc 100644 --- a/models/users +++ b/models/users @@ -10,8 +10,9 @@ User json -- Each Uni2work user has a corresponding row in this table; created upon first login. surname UserSurname -- Display user names always through 'nameWidget displayName surname' displayName UserDisplayName - email (CI Text) -- Case-insensitive eMail address - ident (CI Text) -- Case-insensitive user-identifier + displayEmail UserEmail + email UserEmail -- Case-insensitive eMail address + ident UserIdent -- Case-insensitive user-identifier authentication AuthenticationMode -- 'AuthLDAP' or ('AuthPWHash'+password-hash) lastAuthentication UTCTime Maybe -- last login date created UTCTime default=now() diff --git a/routes b/routes index 9ff5066c9..2d6360ec9 100644 --- a/routes +++ b/routes @@ -71,6 +71,7 @@ /user ProfileR GET POST !free /user/profile ProfileDataR GET !free /user/authpreds AuthPredsR GET POST !free +/user/set-display-email SetDisplayEmailR GET POST !free /term TermShowR GET !free /term/current TermCurrentR GET !free diff --git a/src/Foundation.hs b/src/Foundation.hs index 107f9373a..e62647c90 100644 --- a/src/Foundation.hs +++ b/src/Foundation.hs @@ -1779,9 +1779,10 @@ instance YesodBreadcrumbs UniWorX where breadcrumb InstanceR = return ("Identifikation", Nothing) - breadcrumb ProfileR = return ("User" , Just HomeR) - breadcrumb ProfileDataR = return ("Profile" , Just ProfileR) - breadcrumb AuthPredsR = return ("Authentifizierung", Just ProfileR) + breadcrumb ProfileR = return ("Einstellungen" , Just HomeR) + breadcrumb SetDisplayEmailR = return ("Öffentliche E-Mail Adresse", Just ProfileR) + breadcrumb ProfileDataR = return ("Persönliche Daten", Just ProfileR) + breadcrumb AuthPredsR = return ("Authorisierung" , Just ProfileR) breadcrumb TermShowR = return ("Semester" , Just HomeR) breadcrumb TermCurrentR = return ("Aktuell" , Just TermShowR) @@ -3150,6 +3151,7 @@ upsertCampusUser ldapData Creds{..} = do , userCreated = now , userLastLdapSynchronisation = Just now , userDisplayName = userDisplayName' + , userDisplayEmail = userEmail , .. } userUpdate = [ UserMatrikelnummer =. userMatrikelnummer diff --git a/src/Handler/Course/Show.hs b/src/Handler/Course/Show.hs index 17125062d..f73e6fb94 100644 --- a/src/Handler/Course/Show.hs +++ b/src/Handler/Course/Show.hs @@ -47,7 +47,7 @@ getCShowR tid ssh csh = do E.where_ $ lecturer E.^. LecturerCourse E.==. E.val cid E.orderBy [ E.asc $ user E.^. UserSurname, E.asc $ user E.^. UserDisplayName ] return ( lecturer E.^. LecturerType - , user E.^. UserEmail, user E.^. UserDisplayName, user E.^. UserSurname) + , user E.^. UserDisplayEmail, user E.^. UserDisplayName, user E.^. UserSurname) let partStaff :: (LecturerType, UserEmail, Text, Text) -> Either (UserEmail, Text, Text) (UserEmail, Text, Text) partStaff (CourseLecturer ,name,surn,mail) = Right (name,surn,mail) partStaff (_courseAssistant,name,surn,mail) = Left (name,surn,mail) diff --git a/src/Handler/Profile.hs b/src/Handler/Profile.hs index be6543787..1db807b6f 100644 --- a/src/Handler/Profile.hs +++ b/src/Handler/Profile.hs @@ -5,6 +5,7 @@ import Import import Handler.Utils import Handler.Utils.Table.Cells import Handler.Utils.Profile +import Handler.Utils.Tokens -- import Colonnade hiding (fromMaybe, singleton) -- import Yesod.Colonnade @@ -18,9 +19,12 @@ import qualified Database.Esqueleto.Utils as E import qualified Data.CaseInsensitive as CI +import Jobs + data SettingsForm = SettingsForm { stgDisplayName :: UserDisplayName + , stgDisplayEmail :: UserEmail , stgMaxFavourties :: Int , stgTheme :: Theme , stgDateTime :: DateTimeFormat @@ -63,6 +67,7 @@ makeSettingForm template html = do (result, widget) <- flip (renderAForm FormStandard) html $ SettingsForm <$ aformSection MsgFormPersonalAppearance <*> areq (textField & cfStrip) (fslI MsgUserDisplayName & setTooltip MsgUserDisplayNameRulesBelow) (stgDisplayName <$> template) + <*> areq (emailField & cfStrip & cfCI) (fslI MsgUserDisplayEmail & setTooltip MsgUserDisplayEmailTip) (stgDisplayEmail <$> template) <* aformSection MsgFormCosmetics <*> areq (natFieldI $ MsgNatField "Favoriten") -- TODO: natFieldI not working here (fslpI MsgFavoriten "Anzahl Favoriten") (stgMaxFavourties <$> template) @@ -217,6 +222,7 @@ postProfileR = do return $ school E.^. SchoolId let settingsTemplate = Just SettingsForm { stgDisplayName = userDisplayName + , stgDisplayEmail = userDisplayEmail , stgMaxFavourties = userMaxFavourites , stgTheme = userTheme , stgDateTime = userDateTimeFormat @@ -230,17 +236,21 @@ postProfileR = do ((res,formWidget), formEnctype) <- runFormPost . validateForm (validateSettings user) . identifyForm ProfileSettings $ makeSettingForm settingsTemplate formResult res $ \SettingsForm{..} -> do - runDB $ do - update uid [ UserDisplayName =. stgDisplayName - , UserMaxFavourites =. stgMaxFavourties - , UserTheme =. stgTheme - , UserDateTimeFormat =. stgDateTime - , UserDateFormat =. stgDate - , UserTimeFormat =. stgTime - , UserDownloadFiles =. stgDownloadFiles - , UserWarningDays =. stgWarningDays - , UserNotificationSettings =. stgNotificationSettings - ] + runDBJobs $ do + update uid $ + [ UserDisplayName =. stgDisplayName + , UserMaxFavourites =. stgMaxFavourties + , UserTheme =. stgTheme + , UserDateTimeFormat =. stgDateTime + , UserDateFormat =. stgDate + , UserTimeFormat =. stgTime + , UserDownloadFiles =. stgDownloadFiles + , UserWarningDays =. stgWarningDays + , UserNotificationSettings =. stgNotificationSettings + ] ++ [ UserDisplayEmail =. stgDisplayEmail | userDisplayEmail == stgDisplayEmail ] + when (stgDisplayEmail /= userDisplayEmail) $ do + queueDBJob $ JobChangeUserDisplayEmail uid stgDisplayEmail + addMessageI Info $ MsgUserDisplayEmailChangeSent stgDisplayEmail when (stgMaxFavourties < userMaxFavourites) $ do -- prune Favourites to user-defined size oldFavs <- selectKeysList [ CourseFavouriteUser ==. uid] @@ -267,7 +277,7 @@ postProfileR = do } [ UserSchoolIsOptOut =. True ] - addMessageI Info MsgSettingsUpdate + addMessageI Success MsgSettingsUpdate redirect $ ProfileR :#: ProfileSettings ((tokenRes, tokenFormWidget), tokenEnctype) <- runFormPost . identifyForm ProfileResetTokens $ buttonForm @@ -742,3 +752,43 @@ postUserNotificationR cID = do siteLayoutMsg (MsgNotificationSettingsHeading userDisplayName) $ do setTitleI $ MsgNotificationSettingsHeading userDisplayName formWidget + + +data ButtonSetDisplayEmail = BtnSetDisplayEmail + deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable) +instance Universe ButtonSetDisplayEmail +instance Finite ButtonSetDisplayEmail + +nullaryPathPiece ''ButtonSetDisplayEmail $ camelToPathPiece' 1 +embedRenderMessage ''UniWorX ''ButtonSetDisplayEmail id + +instance Button UniWorX ButtonSetDisplayEmail where + btnClasses _ = [BCIsButton] + + +getSetDisplayEmailR, postSetDisplayEmailR :: Handler Html +getSetDisplayEmailR = postSetDisplayEmailR +postSetDisplayEmailR = do + uid <- requireAuthId + mDisplayEmail <- requireCurrentTokenRestrictions + + case mDisplayEmail of + Nothing -> invalidArgs ["Bearer token required"] + Just displayEmail -> do + ((btnRes, btnView), btnEnc) <- runFormPost $ formEmbedJwtPost buttonForm + let btnView' = wrapForm btnView def + { formSubmit = FormNoSubmit + , formAction = Just $ SomeRoute SetDisplayEmailR + , formEncoding = btnEnc + } + + formResult btnRes $ \case + BtnSetDisplayEmail -> do + runDB $ + update uid [UserDisplayEmail =. displayEmail] + addMessageI Success MsgUserDisplayEmailChanged + redirect ProfileR + + siteLayoutMsg MsgTitleChangeUserDisplayEmail $ do + setTitleI MsgTitleChangeUserDisplayEmail + $(i18nWidgetFile "set-display-email") diff --git a/src/Handler/Users/Add.hs b/src/Handler/Users/Add.hs index 42834eb2e..b8e6efd35 100644 --- a/src/Handler/Users/Add.hs +++ b/src/Handler/Users/Add.hs @@ -16,6 +16,7 @@ data AdminUserForm = AdminUserForm , aufFirstName :: Text , aufSurname :: UserSurname , aufDisplayName :: UserDisplayName + , aufDisplayEmail :: UserEmail , aufMatriculation :: Maybe UserMatriculation , aufEmail :: UserEmail , aufIdent :: UserIdent @@ -44,6 +45,7 @@ adminUserForm template = renderAForm FormStandard <*> areq (textField & cfStrip) (fslI MsgAdminUserFirstName) (aufFirstName <$> template) <*> areq (textField & cfStrip) (fslI MsgAdminUserSurname) (aufSurname <$> template) <*> areq (textField & cfStrip) (fslI MsgAdminUserDisplayName) (aufDisplayName <$> template) + <*> areq (emailField & cfCI) (fslI MsgAdminUserDisplayEmail) (aufDisplayEmail <$> template) <*> aopt (textField & cfStrip) (fslI MsgAdminUserMatriculation) (aufMatriculation <$> template) <*> areq (emailField & cfCI) (fslI MsgAdminUserEmail) (aufEmail <$> template) <*> areq (textField & cfStrip & cfCI) (fslI MsgAdminUserIdent) (aufIdent <$> template) @@ -77,6 +79,7 @@ postAdminUserAddR = do , userLastAuthentication = Nothing , userEmail = aufEmail , userDisplayName = aufDisplayName + , userDisplayEmail = aufDisplayEmail , userFirstName = aufFirstName , userSurname = aufSurname , userTitle = aufTitle diff --git a/src/Jobs.hs b/src/Jobs.hs index e5fee67d6..4a8654d90 100644 --- a/src/Jobs.hs +++ b/src/Jobs.hs @@ -68,6 +68,7 @@ import Jobs.Handler.SendPasswordReset import Jobs.Handler.TransactionLog import Jobs.Handler.SynchroniseLdap import Jobs.Handler.PruneInvitations +import Jobs.Handler.ChangeUserDisplayEmail import Jobs.HealthReport diff --git a/src/Jobs/Handler/ChangeUserDisplayEmail.hs b/src/Jobs/Handler/ChangeUserDisplayEmail.hs new file mode 100644 index 000000000..dd5e8f0d4 --- /dev/null +++ b/src/Jobs/Handler/ChangeUserDisplayEmail.hs @@ -0,0 +1,29 @@ +module Jobs.Handler.ChangeUserDisplayEmail + ( dispatchJobChangeUserDisplayEmail + ) where + +import Import + +import Handler.Utils.Mail +import qualified Data.HashSet as HashSet +import qualified Data.CaseInsensitive as CI + +import Text.Hamlet + +dispatchJobChangeUserDisplayEmail :: UserId -> UserEmail -> Handler () +dispatchJobChangeUserDisplayEmail jUser jDisplayEmail = do + token <- tokenRestrict SetDisplayEmailR jDisplayEmail <$> bearerToken jUser (Just $ HashSet.singleton SetDisplayEmailR) Nothing Nothing Nothing + jwt <- encodeToken token + let + setDisplayEmailUrl :: SomeRoute UniWorX + setDisplayEmailUrl = SomeRoute (SetDisplayEmailR, [(toPathPiece GetBearer, toPathPiece jwt)]) + setDisplayEmailUrl' <- toTextUrl setDisplayEmailUrl + + user@User{..} <- runDB $ getJust jUser + + userMailT jUser $ do + _mailTo .= pure (userAddress user & _addressEmail .~ CI.original jDisplayEmail) + replaceMailHeader "Auto-Submitted" $ Just "auto-generated" + setSubjectI MsgMailSubjectChangeUserDisplayEmail + addAlternatives $ + providePreferredAlternative ($(ihamletFile "templates/mail/changeUserDisplayEmail.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX)) diff --git a/src/Jobs/Types.hs b/src/Jobs/Types.hs index 871f8d38e..a5b6149d9 100644 --- a/src/Jobs/Types.hs +++ b/src/Jobs/Types.hs @@ -64,6 +64,9 @@ data Job = JobSendNotification { jRecipient :: UserId, jNotification :: Notifica } | JobSynchroniseLdapUser { jUser :: UserId } + | JobChangeUserDisplayEmail { jUser :: UserId + , jDisplayEmail :: UserEmail + } deriving (Eq, Ord, Show, Read, Generic, Typeable) data Notification = NotificationSubmissionRated { nSubmission :: SubmissionId } | NotificationSheetActive { nSheet :: SheetId } diff --git a/src/Model/Migration.hs b/src/Model/Migration.hs index c9a2b95ce..fb64f2129 100644 --- a/src/Model/Migration.hs +++ b/src/Model/Migration.hs @@ -485,6 +485,14 @@ customMigrations = Map.fromListWith (>>) DELETE FROM "invitation" WHERE "for"->'junction' = '"UserLecturer"'; |] ) + , ( AppliedMigrationKey [migrationVersion|19.0.0|] [version|20.0.0|] + , whenM (tableExists "user") $ do + [executeQQ| + ALTER TABLE "user" ADD COLUMN IF NOT EXISTS "display_email" citext; + UPDATE "user" SET "display_email" = "email" WHERE "display_email" IS NULL; + ALTER TABLE "user" ALTER COLUMN "display_email" SET NOT NULL; + |] + ) ] diff --git a/templates/i18n/changelog/de.hamlet b/templates/i18n/changelog/de.hamlet index e9fdcff16..ec4302653 100644 --- a/templates/i18n/changelog/de.hamlet +++ b/templates/i18n/changelog/de.hamlet @@ -6,6 +6,7 @@ $newline never