chore(email): dont allow numeric fraport accounts

messages/uniworx/utils/utils/de-de-formal.msg

@@ -77,6 +77,7 @@ MultiUserFieldExplanationAnyUser: Dieses Eingabefeld sucht in den Adressen aller
 MultiUserFieldInvitationExplanation: An Adressen, die so keinem Uni2work-Benutzer/keiner Uni2work-Benutzerin zugeordnet werden können, wird eine Einladung per E-Mail versandt.
 MultiUserFieldInvitationExplanationAlways: Es wird an alle Adressen, die Sie hier angeben, eine Einladung per E-Mail versandt.
 AmbiguousEmail: E-Mail-Adresse nicht eindeutig
+InvalidEmailAddress: E-Mail-Adresse ist ungültig
 UtilExamResultGrade: Note
 UtilExamResultPass: Bestanden/Nicht Bestanden
 UtilExamResultNoShow: Nicht erschienen

messages/uniworx/utils/utils/en-eu.msg

@@ -77,6 +77,7 @@ MultiUserFieldExplanationAnyUser: This input searches through the addresses of a
 MultiUserFieldInvitationExplanation: For addresses, which are not found in this way, an invitation will be sent via email.
 MultiUserFieldInvitationExplanationAlways: An invitation will be sent via email to all addresses you enter here.
 AmbiguousEmail: Email address is ambiguous
+InvalidEmailAddress: Email address is invalid
 UtilExamResultGrade: Grade
 UtilExamResultPass: Passed/Failed
 UtilExamResultNoShow: Not present

src/Handler/Profile.hs

@@ -357,6 +357,10 @@ validateSettings User{..} = do
     userDisplayName == userDisplayName' ||  -- unchanged or valid (invalid displayNames delivered by LDAP are preserved)
     validDisplayName userTitle userFirstName userSurname userDisplayName'    
 
+  userDisplayEmail' <- use _stgDisplayEmail
+  guardValidation MsgInvalidEmailAddress $
+    not (validEmail' userDisplayEmail')
+
   userPostAddress'  <- use _stgPostAddress
   let postalNotSet  = isNothing userPostAddress'
       postalIsValid = validPostAddress userPostAddress'
@@ -445,7 +449,7 @@ serveProfileR (uid, user@User{..}) = do
     now <- liftIO getCurrentTime
     runDBJobs $ do
       update uid $
-        [ UserDisplayEmail         =. stgDisplayEmail   | userDisplayEmail  == stgDisplayEmail  ] ++ -- SJ asks: what does this line achieve?
+        [ UserDisplayEmail         =. stgDisplayEmail   | userDisplayEmail  == stgDisplayEmail  ] ++ -- Note that DisplayEmail changes must be confirmed, see 472
         [ UserPostLastUpdate       =. Just now          | userPostAddress   /= stgPostAddress   ] ++
         [ UserDisplayName          =. stgDisplayName
         , UserMaxFavourites        =. stgMaxFavourites
@@ -617,6 +621,7 @@ makeProfileData (Entity uid User{..}) = do
   mCRoute <- getCurrentRoute
   showAdminInfo <- pure (mCRoute == Just (AdminUserR cID)) `or2M` hasReadAccessTo (AdminUserR cID)  
   tooltipAvsPersNo <- messageI Info MsgAvsPersonNoNotId
+  tooltipInvalidEmail <- messageI Error MsgInvalidEmailAddress
 
   let profileRemarks = $(i18nWidgetFile "profile-remarks")
   return $(widgetFile "profileData")

src/Handler/Utils/Profile.hs

@@ -80,10 +80,16 @@ validPostAddress (Just StoredMarkup {markupInput = addr})
 validPostAddress _ = False
 
 validEmail :: Email -> Bool      -- Email = Text
-validEmail = Email.isValid . encodeUtf8
+validEmail email = validRFC5322 && not invalidFraport
+  where 
+    validRFC5322 = Email.isValid $ encodeUtf8 email
+    invalidFraport = case Text.stripSuffix "@fraport.de" email of  
+      Just fralogin -> all isDigit $ drop 1 fralogin
+      Nothing       -> False
+
 
 validEmail' :: UserEmail -> Bool -- UserEmail = CI Text
-validEmail' = Email.isValid . encodeUtf8 . CI.original
+validEmail' = validEmail . CI.original
 
 -- | returns first argument, if it is a valid email address; returns second argument untested otherwise; convenience function
 pickValidEmail :: UserEmail -> UserEmail -> UserEmail

templates/profileData.hamlet

@@ -57,11 +57,15 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
         _{MsgUserDisplayEmail}
       <dd .deflist__dd .email>
         #{userDisplayEmail}
+          $if not (validEmail' userDisplayEmail)
+            \ ^{messageTooltip tooltipInvalidEmail}
       $if userEmail /= userDisplayEmail
         <dt .deflist__dt>
           _{MsgUserSystemEmail}
         <dd .deflist__dd>
           #{mailtoHtml userEmail}
+            $if not (validEmail' userEmail)
+            \ ^{messageTooltip tooltipInvalidEmail}
       <dt .deflist__dt>
         _{MsgAdminUserPinPassword}
       <dd .deflist__dd>

test/Database/Fill.hs

@@ -164,7 +164,7 @@ fillDb = do
     , userLastAuthentication = Nothing
     , userTokensIssuedAfter = Nothing
     , userMatrikelnummer = Nothing
-    , userEmail  = "jost@tcs.ifi.lmu.de"
+    , userEmail  = "e12345@fraport.de"
     , userDisplayEmail = "jost@tcs.ifi.lmu.de"
     , userDisplayName = "Steffen Jost"
     , userSurname = "Jost"