fraport/fradrive
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

feat(users): allow customisation of displayed email address

Browse Source 
Fixes #459
This commit is contained in:
Gregor Kleen 2019-09-12 17:17:31 +02:00
parent a85f317bf2
commit 2f38278ab1
14 changed files with 154 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
messages/uniworx/de.msg
View File

@ -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.
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

5
models/users
View File

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

1
routes
View File

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

8
src/Foundation.hs
View File

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

2
src/Handler/Course/Show.hs
View File

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

74
src/Handler/Profile.hs
View File

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

3
src/Handler/Users/Add.hs
View File

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

1
src/Jobs.hs
View File

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

29
src/Jobs/Handler/ChangeUserDisplayEmail.hs Normal file
View File

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

3
src/Jobs/Types.hs
View File

@ -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 }

8
src/Model/Migration.hs
View File

@ -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;
|]
)
]

1
templates/i18n/changelog/de.hamlet
View File

@ -6,6 +6,7 @@ $newline never
<ul>
<li>Abschätzung der durch Zentralanmeldung benötigten Kurskapazität
<li>Anpassbare angezeigte Namen
<li>Anpassbare angezeigte E-Mail Adressen
<dt .deflist__dt>
^{formatGregorianW 2019 09 05}

4
templates/i18n/set-display-email/de.hamlet Normal file
View File

@ -0,0 +1,4 @@
$newline never
<p>
Möchten Sie die, öffentlich im Zusammenhang mit Ihrem Namen angezeigte, E-Mail Adresse wirklich auf „#{displayEmail}“ setzen?
^{btnView'}

19
templates/mail/changeUserDisplayEmail.hamlet Normal file
View File

@ -0,0 +1,19 @@
$newline never
\<!doctype html>
<html>
<head>
<meta charset="UTF-8">
<style>
h1 {
font-size: 1.25em;
font-variant: small-caps;
font-weight: normal;
}
<body>
<h1>
_{MsgMailTitleChangeUserDisplayEmail userDisplayName}
<p>
_{MsgMailIntroChangeUserDisplayEmail jDisplayEmail}
<p>
<a href=#{setDisplayEmailUrl'}>
_{MsgBtnSetDisplayEmail}