refactor(user): empty postal uses high priority company address instead working

models/company.model

@@ -10,7 +10,7 @@ Company
   avsId           Int     default=0       -- primary key from avs, use negative numbers for non-AVS companies 
   prefersPostal   Bool    default=false   -- new company users prefers letters by post instead of email
   postAddress     StoredMarkup Maybe      -- default company postal address, including company name 
-  email           UserEmail Maybe         -- Case-insensitive generic company eMail address
+  email           UserEmail Maybe         -- Case-insensitive generic company eMail address  
   UniqueCompanyName name 
   -- UniqueCompanyShorthand shorthand     -- unnecessary, since it is the primary key already
   UniqueCompanyAvsId avsId  

models/users.model

@@ -46,7 +46,7 @@ User json    -- Each Uni2work user has a corresponding row in this table; create
     companyDepartment     Text Maybe -- thus we store such information for ease of reference directly, if available 
     pinPassword           Text Maybe -- used to encrypt pins within emails
     postAddress           StoredMarkup Maybe    -- including company name, if any, but excluding username; leave empty for using auto-update CompanyPostAddress via UserCompany
-    postLastUpdate        UTCTime Maybe         -- record postal address updates    
+    postLastUpdate        UTCTime Maybe         -- record postal address updates
     prefersPostal         Bool default=false    -- user prefers letters by post instead of email
     examOfficeGetSynced   Bool default=true     -- whether synced status should be displayed for exam results by default
     examOfficeGetLabels   Bool default=true     -- whether labels should be displayed for exam results by default

src/Handler/Admin.hs

@@ -168,9 +168,9 @@ retrieveUnreachableUsers = do
       E.where_ $   E.isNothing (user E.^. UserPostAddress)
             E.&&. (E.isNothing (user E.^. UserCompanyDepartment) E.||. user E.^. UserCompanyPersonalNumber `E.ilike` E.justVal "E%")    
       return user
-    return $ filter hasInvalidEmail emailOnlyUsers
+    filterM hasInvalidEmail emailOnlyUsers    
   where 
-    hasInvalidEmail = isNothing . getEmailAddress . entityVal
+    hasInvalidEmail = fmap isNothing . getEmailAddress
   
 
 allDriversHaveAvsId :: UTCTime -> DB Bool

src/Handler/Admin/Test.hs

@@ -354,7 +354,7 @@ getAdminTestPdfR = do
         , isReminder    = False
         }  
   apcIdent <- letterApcIdent letter encRecipient now
-  renderLetterPDF usr letter apcIdent >>= \case
+  renderLetterPDF usr letter apcIdent Nothing >>= \case
     Left err  -> sendResponseStatus internalServerError500 $ "PDF generation failed: \n" <> err
     Right pdf -> do
       liftIO $ LBS.writeFile "/tmp/generated.pdf" pdf

src/Handler/Firm.hs

@@ -28,7 +28,8 @@ import qualified Data.Map as Map
 -- import qualified Data.Text as T
 import qualified Data.CaseInsensitive as CI
 -- import qualified Data.Conduit.List as C
-import Database.Persist.Sql (deleteWhereCount, updateWhereCount)
+-- import Database.Persist.Sql (deleteWhereCount, updateWhereCount)
+import Database.Persist.Postgresql
 import           Database.Esqueleto.Experimental ((:&)(..))
 import qualified Database.Esqueleto.Experimental as E -- needs TypeApplications Lang-Pragma
 import qualified Database.Esqueleto.Legacy as EL (on)
@@ -161,7 +162,9 @@ firmActionHandler route isAdmin = flip formResult faHandler
         addMessageI Warning MsgFirmActAddSupersEmpty
         reloadKeepGetParams route
       runDB $ do
-        putMany [UserCompany uid cid True firmActAddSupervisorReroute | uid <- usersFound]
+        -- putMany [UserCompany uid cid True firmActAddSupervisorReroute 0 False | uid <- usersFound] -- putMany always overwrites existing records, which would destroy priority and useCompanyAddress here
+        -- upsertManyWhere [UserCompany uid cid True firmActAddSupervisorReroute 0 False | uid <- usersFound] [copyField UserCompanySupervisor, copyField UserCompanySupervisorReroute] [] [] -- overwrite Supervisor and SupervisorReroute, keep priority and useCompanyAddress
+        upsertManyWhere [UserCompany uid cid True firmActAddSupervisorReroute 0 False | uid <- usersFound] [] [UserCompanySupervisor =. True, UserCompanySupervisorReroute =. firmActAddSupervisorReroute] [] -- identical to previous line, but perhaps more clear?
         whenIsJust firmActAddSupervisorPostal $ \prefPostal ->
           updateWhere [UserId <-. usersFound] [UserPrefersPostal =. prefPostal]
         addMessageI Success $ MsgFirmActAddSupersSet (fromIntegral $ length usersFound) firmActAddSupervisorPostal

src/Handler/Profile.hs

@@ -20,6 +20,7 @@ import Import
 
 import Handler.Utils
 import Handler.Utils.Profile
+import Handler.Utils.Users
 
 import Utils.Print (validCmdArgument)
 
@@ -583,9 +584,12 @@ getForProfileDataR cID = do
     dataWidget
 
 makeProfileData :: Entity User -> DB Widget
-makeProfileData (Entity uid User{..}) = do
+makeProfileData usrEnt@(Entity uid User{..}) = do
   now <- liftIO getCurrentTime
-  avsId <- entityVal <<$>> getBy (UniqueUserAvsUser uid)  
+  avsId <- entityVal <<$>> getBy (UniqueUserAvsUser uid)
+  (actualPrefersPostal, actualPostAddress, actualDisplayEmail) <- getPostalPreferenceAndAddress' usrEnt
+  let postalAutomatic = isJust actualPostAddress  && isNothing userPostAddress          -- address is either from company or department                    
+      emailAutomatic  = isJust actualDisplayEmail && not (validEmail' userDisplayEmail)
   functions <- Map.fromListWith Set.union . map (\(Entity _ UserFunction{..}) -> (userFunctionFunction, Set.singleton userFunctionSchool)) <$> selectList [UserFunctionUser ==. uid] []
   lecture_corrector <- E.select $ E.distinct $ E.from $ \(sheet `E.InnerJoin` corrector `E.InnerJoin` course) -> do
       E.on $ sheet E.^. SheetCourse E.==. course    E.^. CourseId

src/Handler/Utils/Avs.hs

@@ -494,9 +494,11 @@ updateAvsUserByIds apids = do
                         eml_new = (newAvsFirmInfo ^.         _avsFirmPrimaryEmail) <|> (newAvsPersonInfo ^.         _avsInfoPersonEMail)
                     in mkUpdate usr eml_new eml_old $
                       CheckAvsUpdate UserDisplayEmail           $ to (fromMaybe mempty) . from _CI                                        -- Maybe nicht im User, aber im AvsInfo PROBLEM: Hängt auch von der FirmenEmail ab und muss daher im Verbund betrachtet werden.
+          -- TODO: company address no longer stored with each individual user
           frm_ups = maybeEmpty oldAvsFirmInfo $ \oldAvsFirmInfo' -> mapMaybe (mkUpdate usr newAvsFirmInfo oldAvsFirmInfo')                    
                     [ CheckAvsUpdate UserPostAddress _avsFirmPostAddress 
                     ]
+          
           usr_ups = mcons eml_up $ frm_ups <> per_ups
           avs_ups = ((UserAvsNoPerson =.) <$> readMay (avsInfoPersonNo newAvsPersonInfo)) `mcons`
                     [ UserAvsLastSynch      =. now

src/Handler/Utils/Users.hs

@@ -16,7 +16,8 @@ module Handler.Utils.Users
   , UserAssimilateException(..), UserAssimilateExceptionReason(..)
   , assimilateUser
   , getEmailAddress
-  , getPostalAddress, getPostalPreferenceAndAddress
+  , getPostalAddress, getPostalAddress'
+  , getPostalPreferenceAndAddress, getPostalPreferenceAndAddress'
   , abbrvName
   , getReceivers, getReceiversFor
   , getSupervisees
@@ -66,6 +67,16 @@ abbrvName User{userDisplayName, userFirstName, userSurname} =
     assemble = Text.intercalate "."
 
 
+getUserCompanyAddress :: UserId -> (Company -> Maybe a) -> DB (Maybe a)
+getUserCompanyAddress uid prj = runMaybeT $ do
+  Entity{entityVal=UserCompany{userCompanyCompany=cid}} <- MaybeT $ 
+    selectFirst [UserCompanyUser ==. uid, UserCompanyUseCompanyAddress ==. True] 
+                [Desc UserCompanyPriority, Desc UserCompanySupervisorReroute, Desc UserCompanySupervisor, Asc UserCompanyCompany]
+  company <- MaybeT $ get cid
+  -- hoistMaybe $ prj company
+  MaybeT $ pure $ prj company
+  
+
 -- | result (True, Nothing, Nothing) indicates that neither userEmail nor userPostAddress is known
 getPostalPreferenceAndAddress :: Entity User -> DB (Bool, Maybe [Text], Maybe UserEmail)
 getPostalPreferenceAndAddress usr = do
@@ -75,6 +86,17 @@ getPostalPreferenceAndAddress usr = do
       finalPref   = (usrPrefPost && isJust pa) || isNothing em
       -- finalPref   = isJust pa && (usrPrefPost || isNothing em)
   return (finalPref, pa, em)
+
+-- | result (True, Nothing, Nothing) indicates that neither userEmail nor userPostAddress is known
+--   primed variant returns storedMarkup without prefixed userDisplayName
+getPostalPreferenceAndAddress' :: Entity User -> DB (Bool, Maybe StoredMarkup, Maybe UserEmail)
+getPostalPreferenceAndAddress' usr = do
+  pa <- getPostalAddress' usr
+  em <- getEmailAddress   usr
+  let usrPrefPost = usr ^. _entityVal . _userPrefersPostal
+      finalPref   = (usrPrefPost && isJust pa) || isNothing em
+      -- finalPref   = isJust pa && (usrPrefPost || isNothing em)
+  return (finalPref, pa, em)
  
     
 getEmailAddress :: Entity User -> DB (Maybe UserEmail)
@@ -83,26 +105,19 @@ getEmailAddress Entity{entityKey=uid, entityVal=User{userDisplayEmail, userEmail
     = return $ Just userDisplayEmail
   | otherwise
     = do
-        compEmailMb <- runMaybeT $ do
+        compEmailMb <- getUserCompanyAddress uid companyEmail
-          Entity{entityVal=UserCompany{userCompanyCompany=cid}} <- MaybeT $ selectFirst [UserCompanyUser ==. uid, UserCompanyUseCompanyAddress ==. True] [Desc UserCompanyPriority]
-          Company{companyEmail} <- MaybeT $ get cid
-          MaybeT $ return companyEmail
         return $ pickValidEmail' $ mcons compEmailMb [userEmail]
 
-
+-- address is prefixed with userDisplayName
 getPostalAddress :: Entity User -> DB (Maybe [Text])
 getPostalAddress Entity{entityKey=uid, entityVal=User{..}}
   | Just pa <- userPostAddress
     = prefixMarkupName pa
   | otherwise
     = do
-        compAddrMb <- runMaybeT $ do
+        getUserCompanyAddress uid companyPostAddress >>= \case
-          Entity{entityVal=UserCompany{userCompanyCompany=cid}} <- MaybeT $ selectFirst [UserCompanyUser ==. uid, UserCompanyUseCompanyAddress ==. True] [Desc UserCompanyPriority]
-          Company{companyPostAddress} <- MaybeT $ get cid
-          MaybeT $ return companyPostAddress
-        case compAddrMb of
           (Just pa)
-            -> prefixMarkupName pa
+              -> prefixMarkupName pa
           Nothing 
             | Just abt <- userCompanyDepartment
               -> return $ Just $ if | "BVD" `isPrefixOf` abt -> [userDisplayName, abt, "Bodenverkehrsdienste"]
@@ -111,6 +126,22 @@ getPostalAddress Entity{entityKey=uid, entityVal=User{..}}
   where 
     prefixMarkupName = return . Just . (userDisplayName :) . html2textlines
 
+--  primed variant returns storedMarkup without prefixed userDisplayName
+getPostalAddress' :: Entity User -> DB (Maybe StoredMarkup)
+getPostalAddress' Entity{entityKey=uid, entityVal=User{..}}
+  | res@(Just _) <- userPostAddress
+    = return res
+  | otherwise
+    = do
+        getUserCompanyAddress uid companyPostAddress >>= \case
+          res@(Just _)
+              -> return res
+          Nothing 
+            | Just abt <- userCompanyDepartment
+              -> return $ Just $ plaintextToStoredMarkup $ textUnlines $ 
+                    if  | "BVD" `isPrefixOf` abt -> [userDisplayName, abt, "Bodenverkehrsdienste"]
+                        | otherwise              -> [userDisplayName, abt, "Hausbriefkasten"     ]
+            | otherwise -> return Nothing
 
 -- | Consider using Handler.Utils.Avs.updateReceivers instead
 --   Return Entity User and all Supervisors with rerouteNotifications as well as

src/Utils/DB.hs

@@ -44,7 +44,8 @@ fieldLensVal f = entityLens . fieldLens f
     getVal :: record -> Entity record
     getVal   = Entity (error "fieldLensVal unexpectectly required an entity key") -- this is safe, since the lens is only used locally
     setVal :: record -> Entity record -> record
-    setVal _ = entityVal
+    -- setVal _ = entityVal
+    setVal = const -- TODO verify
     
 
 emptyOrIn :: PersistField typ

src/Utils/Icon.hs

@@ -118,6 +118,7 @@ data Icon
   | IconCompany
   | IconEdit
   | IconUserEdit
+  | IconMagic      -- indicates automatic updates
   
   deriving (Eq, Ord, Enum, Bounded, Show, Read, Generic)
   deriving anyclass (Universe, Finite, NFData)
@@ -214,6 +215,7 @@ iconText = \case
     IconCompany                 -> "building"
     IconEdit                    -> "edit"
     IconUserEdit                -> "user-edit"
+    IconMagic                   -> "wand-magic"
 
 nullaryPathPiece ''Icon $ camelToPathPiece' 1
 deriveLift ''Icon
@@ -291,11 +293,16 @@ isBad :: Bool -> Markup
 isBad True  = icon IconProblem
 isBad False = mempty
 
--- ^ Maybe display an icon that denotes that something™ is bad
+-- ^ Maybe display an icon that denotes that something™ is new
 isNew :: Bool -> Markup
 isNew True  = icon IconNew
 isNew False = mempty
 
+-- ^ Maybe display an icon that denotes that something™ is automagically updated or derived
+isAutomatic :: Bool -> Markup
+isAutomatic True  = icon IconMagic
+isAutomatic False = mempty
+
 boolSymbol :: Bool -> Markup
 boolSymbol True  = icon IconOK
 boolSymbol False = icon IconNotOK

src/Utils/Mail.hs

@@ -19,7 +19,7 @@ validEmail email = validRFC5322 && not invalidFraport
   where 
     validRFC5322 = Email.isValid $ encodeUtf8 email
     invalidFraport = case Text.stripSuffix "@fraport.de" (foldCase email) of  
-      Just fralogin -> Text.all Char.isDigit $ Text.drop 1 fralogin
+      Just fralogin -> Text.all Char.isDigit $ Text.drop 1 fralogin          -- Emails like E1234@fraport.de or 012345!fraport.de are not read
       Nothing       -> False
 
 validEmail' :: CI Text -> Bool -- UserEmail = CI Text

src/Utils/Print.hs

@@ -145,58 +145,41 @@ pdfLaTeX lk doc = do
       let writerOpts  = def { P.writerExtensions = P.pandocExtensions
                             , P.writerTemplate   = Just tmpl }      
       makePDF writerOpts $ appMeta setIsDeFromLang doc
-      
 
-renderLetterPDF :: (MDLetter l) => Entity User -> l -> Text -> Handler (Either Text LBS.ByteString)
-renderLetterPDF rcvrEnt@Entity{entityVal=rcvr} mdl apcIdent = do
-  rcvrPostal <- runDB $ getPostalAddress rcvrEnt
-  -- (_,rcvrPostal, rcvrEmail) <- runDB $ getPostalPreferenceAndAddress
-  renderLetterPDFto $ fromMaybe [rcvr & userDisplayName] rcvrPostal
 
-renderLetterPDFto :: (MDLetter l) => [Text] -> Entity User -> l -> Text -> Handler (Either Text LBS.ByteString)
+letterTemplate :: (MDLetter l) => Entity User -> l -> Text -> Maybe [Text] -> Handler (Either Text P.Pandoc)
-renderLetterPDFto rcvrPostal rcvrEnt@Entity{entityVal=rcvr} mdl apcIdent = do
+letterTemplate rcvrEnt@Entity{entityVal=rcvr} mdl apcIdent rcvrPostalRaw = do
   now <- liftIO getCurrentTime  
-  formatter@DateTimeFormatter{ format } <- getDateTimeFormatterUser' rcvr    
+  formatter@DateTimeFormatter{ format } <- getDateTimeFormatterUser' rcvr
-  let lang = selectDeEn $ rcvr & userLanguages   -- select either German or English only, default de; see Utils.Lang
+  rcvrPostal <- altM (return rcvrPostalRaw) $ runDB $ getPostalAddress rcvrEnt
-      kind = getLetterKind        mdl
+  -- (_,rcvrPostal, rcvrEmail) <- runDB $ getPostalPreferenceAndAddress
-      tmpl = getTemplate          mdl
+  let lang = selectDeEn $ rcvr & userLanguages   -- select either German or English only, default de; see Utils.Lang      
+      tmpl = getTemplate mdl
       meta = addApcIdent apcIdent
           <> letterMeta mdl formatter lang rcvrEnt
           <> mkMeta
             [ -- toMeta "lang" lang -- receiver language is decided in MDLetter instance, since some letters have fixed languages
               toMeta "date"       $ format SelFormatDate now
             , toMeta "rcvr-name"  $ rcvr & userDisplayName
-            , toMeta "address"    $ rcvrPostal            
+            , toMeta "address"    $ fromMaybe [rcvr & userDisplayName] $ canonical rcvrPostal            
+            --, toMeta "rcvr-email"    $ fromMaybe [rcvr & userDisplayEmail] rcvrEmail -- note that some templates use "email" already otherwise
             ]
-  e_md <- mdTemplating tmpl meta
+  mdTemplating tmpl meta
-  actRight e_md $ pdfLaTeX kind
 
+renderLetterPDF :: (MDLetter l) => Entity User -> l -> Text -> Maybe [Text] -> Handler (Either Text LBS.ByteString)
+renderLetterPDF rcvrEnt mdl apcIdent rcvrPostal = do
+  e_md <- letterTemplate rcvrEnt mdl apcIdent rcvrPostal
+  actRight e_md $ pdfLaTeX $ getLetterKind mdl
 
-renderLetterHtml :: (MDLetter l) => Entity User -> l -> Text -> Handler (Either Text Html)
+renderLetterHtml :: (MDLetter l) => Entity User -> l -> Text -> Maybe [Text] -> Handler (Either Text Html)
-renderLetterHtml rcvrEnt@Entity{entityVal=rcvr} mdl apcIdent = do
+renderLetterHtml rcvrEnt mdl apcIdent rcvrPostal = do
-    now <- liftIO getCurrentTime  
+  e_md <- letterTemplate rcvrEnt mdl apcIdent rcvrPostal
-    formatter@DateTimeFormatter{ format } <- getDateTimeFormatterUser' rcvr
+  actRight e_md $ \md -> pure . over _Left P.renderError . P.runPure $ do   
-    rcvrPostal <- runDB $ getPostalAddress rcvrEnt
+    html_tmpl <- compileTemplate $ templateHtml $ getLetterKind mdl
-    -- (_,rcvrPostal, rcvrEmail) <- runDB $ getPostalPreferenceAndAddress
+    -- html_tmpl <- ExceptT $ memcachedBy (Just . Right $ 6 * diffHour) ("LetterKind-Html: \n" <> tshow lk) (pure . over _Left P.renderError . P.runPure $ compileTemplate $ templateHtml lk)
-    let lang = selectDeEn $ rcvr & userLanguages   -- select either German or English only, default de; see Utils.Lang
+    let writerOpts  = def { P.writerExtensions = P.pandocExtensions
-        kind = getLetterKind        mdl
+                          , P.writerTemplate   = Just html_tmpl }
-        tmpl = getTemplate          mdl
+    P.writeHtml5 writerOpts $ appMeta setIsDeFromLang md
-        meta = addApcIdent apcIdent
-            <> letterMeta mdl formatter lang rcvrEnt
-            <> mkMeta
-              [ -- toMeta "lang" lang -- receiver language is decided in MDLetter instance, since some letters have fixed languages
-                toMeta "date"       $ format SelFormatDate now
-              , toMeta "rcvr-name"  $ rcvr & userDisplayName
-              , toMeta "address"    $ fromMaybe [rcvr & userDisplayName] rcvrPostal
-              --, toMeta "rcvr-email"    $ fromMaybe [rcvr & userDisplayEmail] rcvrEmail -- note that some templates use "email" already otherwise
-              ]
-    e_md <- mdTemplating tmpl meta
-    actRight e_md $ \md -> pure . over _Left P.renderError . P.runPure $ do   
-      html_tmpl <- compileTemplate $ templateHtml kind
-      -- html_tmpl <- ExceptT $ memcachedBy (Just . Right $ 6 * diffHour) ("LetterKind-Html: \n" <> tshow lk) (pure . over _Left P.renderError . P.runPure $ compileTemplate $ templateHtml lk)
-      let writerOpts  = def { P.writerExtensions = P.pandocExtensions
-                            , P.writerTemplate   = Just html_tmpl }
-      P.writeHtml5 writerOpts $ appMeta setIsDeFromLang md
 
 -- TODO: apcIdent does not make sense for multiple letters 
 renderLetters :: (MDLetter l, Foldable f) => Entity User -> f l -> Text -> Handler (Either Text LBS.ByteString)
@@ -243,7 +226,7 @@ printHtml _senderId (rcvr, letter) = do
   encRecipient :: CryptoUUIDUser <- encrypt rcvrId
   now <- liftIO getCurrentTime
   apcIdent <- letterApcIdent letter encRecipient now
-  renderLetterHtml rcvr letter apcIdent
+  renderLetterHtml rcvr letter apcIdent Nothing
   
 -- Only used in print-test-handler for PrintSendR
 printLetter :: (MDLetter l) => Maybe UserId -> (Entity User, l) -> Handler (Either Text (Text, FilePath))
@@ -252,7 +235,7 @@ printLetter senderId (rcvr, letter) = do
   encRecipient :: CryptoUUIDUser <- encrypt rcvrId
   now <- liftIO getCurrentTime
   apcIdent <- letterApcIdent letter encRecipient now
-  pdf <- renderLetterPDF rcvr letter apcIdent
+  pdf <- renderLetterPDF rcvr letter apcIdent Nothing
   let protoPji = getPJId letter 
       pji = protoPji 
               { pjiRecipient = Just rcvrId
@@ -341,14 +324,14 @@ sendEmailOrLetter recipient letter = do
         mailSubject   = mkMailSubject isSupervised
     encRecipient :: CryptoUUIDUser <- encrypt svr
     apcIdent <- letterApcIdent letter encRecipient now
-    postalPrefs <- getPostalPreferenceAndAddress rcvrEnt
+    postalPrefs <- runDB $ getPostalPreferenceAndAddress rcvrEnt
     case postalPrefs of 
       (_, Nothing, Nothing) -> do -- neither email nor postal is known
         let msg = "Notification failed for " <> tshow encRecipient <> ", who has neither a known email nor postal address. Notification: " <> tshow pjid
         $logErrorS "LETTER" msg
         return False
 
-      (True , Just postal, _) -> renderLetterPDFto postal rcvrEnt letter apcIdent >>= \case -- send printed letter
+      (True, postal@(Just _), _) -> renderLetterPDF rcvrEnt letter apcIdent postal >>= \case -- send printed letter
           Left err -> do -- pdf generation failed 
             let msg = "Notification failed for " <> tshow encRecipient <> ". PDF generation failed: "<> cropText err <> "For Notification: " <> tshow pjid
             $logErrorS "LETTER" msg
@@ -364,7 +347,7 @@ sendEmailOrLetter recipient letter = do
                   $logWarnS "LETTER" $ "PDF printing to send letter with lpr returned ExitSuccess and the following message: " <> msg
                   return True
 
-      (False, _) | Just mkMail <- mkMailBody -> renderLetterPDF rcvrEnt letter apcIdent >>= \case -- send Email, but with pdf attached 
+      (_, postal, _email) | Just mkMail <- mkMailBody -> renderLetterPDF rcvrEnt letter apcIdent postal >>= \case -- send Email with pdf attached 
           Left err -> do -- pdf generation failed 
             let msg = "Notification failed for " <> tshow encRecipient <> ". PDF attachment generation failed: "<> cropText err <> "For Notification: " <> tshow pjid
             $logErrorS "LETTER" msg
@@ -384,6 +367,7 @@ sendEmailOrLetter recipient letter = do
                   return pdf
             formatter <- getDateTimeFormatterUser' rcvrUsr -- not too expensive, only calls getTimeLocale
             let mailBody = mkMail formatter
+            -- userMailTdirect computes email address once more, hence _email is currently ignored
             userMailTdirect svr $ do
               replaceMailHeader "Auto-Submitted" $ Just "auto-generated"
               setSubjectI mailSubject
@@ -395,7 +379,7 @@ sendEmailOrLetter recipient letter = do
                             } :: PureFile)
             return True
 
-      (False, _) -> renderLetterHtml rcvrEnt letter apcIdent >>= \case -- send Email, render letter directly to html
+      (_, postal, _email) -> renderLetterHtml rcvrEnt letter apcIdent postal >>= \case -- send Email, render letter directly to html
           Left err -> do -- html generation failed 
             let msg = "Notification failed for " <> tshow encRecipient <> ". HTML generation failed: "<> cropText err <> "For Notification: " <> tshow pjid
             $logErrorS "LETTER" msg
@@ -403,9 +387,9 @@ sendEmailOrLetter recipient letter = do
           Right html -> do -- html generated, send directly now                  
             userMailTdirect svr $ do
               replaceMailHeader "Auto-Submitted" $ Just "auto-generated"
-              setSubjectI mailSubject              
+              setSubjectI mailSubject     
               addHtmlMarkdownAlternatives html
-            return True        
+            return True
   return $ or oks
 
 

templates/profileData.hamlet

@@ -51,30 +51,37 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
       <dt .deflist__dt>
         _{MsgPrefersPostalExp}
       <dd .deflist__dd>
+        $if userPrefersPostal /= actualPrefersPostal
+          ^{messageTooltip tooltipInvalidEmail} #
         #{iconLetterOrEmail userPrefersPostal}
-      $maybe addr <- userPostAddress
+      $maybe addr <- actualPostAddress
         <dt .deflist__dt>
           _{MsgAdminUserPostAddress}
         <dd .deflist__dd>  
+          #{isAutomatic postalAutomatic} #
           #{addr}
-        $maybe postUpdate <- userPostLastUpdate
+        $if (not postalAutomatic)
-          <dt .deflist__dt>
+          $maybe postUpdate <- userPostLastUpdate
-            _{MsgUserPostLastUpdate}
+            <dt .deflist__dt>
-          <dd .deflist__dd>
+              _{MsgUserPostLastUpdate}
-            ^{formatTimeW SelFormatDateTime postUpdate}      
+            <dd .deflist__dd>
+              ^{formatTimeW SelFormatDateTime postUpdate}
       <dt .deflist__dt>
         _{MsgUserDisplayEmail}
       <dd .deflist__dd .email>
-        #{mailtoHtml userDisplayEmail}
+        $maybe primaryEmail <- actualDisplayEmail
-          $if not (validEmail' userDisplayEmail)
+          #{isAutomatic emailAutomatic} #
-            \ ^{messageTooltip tooltipInvalidEmail}
+          #{mailtoHtml primaryEmail}
-      $if userEmail /= userDisplayEmail
+        $nothing
+          ^{messageTooltip tooltipInvalidEmail} #
+          #{mailtoHtml userDisplayEmail}          
+      $if Just userEmail /= actualDisplayEmail
         <dt .deflist__dt>
           _{MsgUserSystemEmail}
-        <dd .deflist__dd>
+        <dd .deflist__dd>          
+          $if not (validEmail' userEmail)
+            ^{messageTooltip tooltipInvalidEmail} #
           #{userEmail}
-            $if not (validEmail' userEmail)
-              \ ^{messageTooltip tooltipInvalidEmail}
       <dt .deflist__dt>
         _{MsgAdminUserPinPassword}
       <dd .deflist__dd>

test/Database/Fill.hs

@@ -655,19 +655,19 @@ fillDb = do
                           , let rcName  = CI.mk $ "Random Corp " <> tshow n <> bool "" " GmbH" (even n)
                           , let rcShort = CI.mk $ "RC" <> tshow n
                           ]
-  void . insert' $ UserCompany jost    fraportAg    True   True 
+  void . insert' $ UserCompany jost    fraportAg    True   True  0 False
-  void . insert' $ UserCompany svaupel nice         True   False 
+  void . insert' $ UserCompany svaupel nice         True   False 0 False
-  void . insert' $ UserCompany gkleen  nice         False  False 
+  void . insert' $ UserCompany gkleen  nice         False  False 1 True
-  void . insert' $ UserCompany gkleen  fraGround    False  True 
+  void . insert' $ UserCompany gkleen  fraGround    False  True  2 False
-  void . insert' $ UserCompany fhamann bpol         False  False 
+  void . insert' $ UserCompany fhamann bpol         False  False 1 True
-  void . insert' $ UserCompany fhamann ffacil       True   True 
+  void . insert' $ UserCompany fhamann ffacil       True   True  2 True
-  void . insert' $ UserCompany fhamann nice         False  False
+  void . insert' $ UserCompany fhamann nice         False  False 3 False
   -- need more tests
-  insertMany_ [UserCompany uid fraGround False False| Entity uid User{userFirstName = "John"} <- matUsers]
+  insertMany_ [UserCompany uid fraGround False False 0 True | Entity uid User{userFirstName = "John"} <- matUsers]
-  insertMany_ [UserCompany uid bpol False False| Entity uid User{userFirstName = "Elizabeth"} <- matUsers]
+  insertMany_ [UserCompany uid bpol False False 0 False     | Entity uid User{userFirstName = "Elizabeth"} <- matUsers]
-  insertMany_ [UserCompany uid bpol True True| Entity uid User{userFirstName = "Clark", userSurname = dn} <- matUsers, dn == "Walker" || dn == "Robinson"]
+  insertMany_ [UserCompany uid bpol True True 0 True        | Entity uid User{userFirstName = "Clark", userSurname = dn} <- matUsers, dn == "Walker" || dn == "Robinson"]
-  insertMany_ [UserCompany uid ffacil False False| Entity uid User{userSurname = "Walker"} <- matUsers]
+  insertMany_ [UserCompany uid ffacil False False 0 False   | Entity uid User{userSurname = "Walker"} <- matUsers]
-  insertMany_ [UserCompany uid rckey issuper False
+  insertMany_ [UserCompany uid rckey issuper False 0 True
               | rckey <- randComps
               , Just n <- [readMay $ drop 2 $ unpack $ CI.original $ unCompanyKey rckey]
               , Entity uid User{userSurname = uSurname} <- take (n `div` 20) $ drop (2*n) matUsers