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

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

Browse Source
This commit is contained in:
Steffen Jost 2024-03-08 18:06:52 +01:00
parent 9985151002
commit 09d10e1ba2
14 changed files with 136 additions and 97 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
models/company.model
View File

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

2
models/users.model
View File

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

4
src/Handler/Admin.hs
View File

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

2
src/Handler/Admin/Test.hs
View File

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

7
src/Handler/Firm.hs
View File

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

8
src/Handler/Profile.hs
View File

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

2
src/Handler/Utils/Avs.hs
View File

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

55
src/Handler/Utils/Users.hs
View File

@ -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
Entity{entityVal=UserCompany{userCompanyCompany=cid}} <- MaybeT $ selectFirst [UserCompanyUser ==. uid, UserCompanyUseCompanyAddress ==. True] [Desc UserCompanyPriority]
Company{companyEmail} <- MaybeT $ get cid
MaybeT $ return companyEmail
compEmailMb <- getUserCompanyAddress uid 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
Entity{entityVal=UserCompany{userCompanyCompany=cid}} <- MaybeT $ selectFirst [UserCompanyUser ==. uid, UserCompanyUseCompanyAddress ==. True] [Desc UserCompanyPriority]
Company{companyPostAddress} <- MaybeT $ get cid
MaybeT $ return companyPostAddress
case compAddrMb of
getUserCompanyAddress uid companyPostAddress >>= \case
(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

3
src/Utils/DB.hs
View File

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

9
src/Utils/Icon.hs
View File

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

2
src/Utils/Mail.hs
View File

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

80
src/Utils/Print.hs
View File

@ -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)
renderLetterPDFto rcvrPostal rcvrEnt@Entity{entityVal=rcvr} mdl apcIdent = do
letterTemplate :: (MDLetter l) => Entity User -> l -> Text -> Maybe [Text] -> Handler (Either Text P.Pandoc)
letterTemplate rcvrEnt@Entity{entityVal=rcvr} mdl apcIdent rcvrPostalRaw = do
now <- liftIO getCurrentTime
formatter@DateTimeFormatter{ format } <- getDateTimeFormatterUser' rcvr
let lang = selectDeEn $ rcvr & userLanguages -- select either German or English only, default de; see Utils.Lang
kind = getLetterKind mdl
tmpl = getTemplate mdl
formatter@DateTimeFormatter{ format } <- getDateTimeFormatterUser' rcvr
rcvrPostal <- altM (return rcvrPostalRaw) $ runDB $ getPostalAddress rcvrEnt
-- (_,rcvrPostal, rcvrEmail) <- runDB $ getPostalPreferenceAndAddress
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
actRight e_md $ pdfLaTeX kind
mdTemplating tmpl meta
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 rcvrEnt@Entity{entityVal=rcvr} mdl apcIdent = do
now <- liftIO getCurrentTime
formatter@DateTimeFormatter{ format } <- getDateTimeFormatterUser' rcvr
rcvrPostal <- runDB $ getPostalAddress rcvrEnt
-- (_,rcvrPostal, rcvrEmail) <- runDB $ getPostalPreferenceAndAddress
let lang = selectDeEn $ rcvr & userLanguages -- select either German or English only, default de; see Utils.Lang
kind = getLetterKind mdl
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" $ 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
renderLetterHtml :: (MDLetter l) => Entity User -> l -> Text -> Maybe [Text] -> Handler (Either Text Html)
renderLetterHtml rcvrEnt mdl apcIdent rcvrPostal = do
e_md <- letterTemplate rcvrEnt mdl apcIdent rcvrPostal
actRight e_md $ \md -> pure . over _Left P.renderError . P.runPure $ do
html_tmpl <- compileTemplate $ templateHtml $ getLetterKind mdl
-- 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

33
templates/profileData.hamlet
View File

@ -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
<dt .deflist__dt>
_{MsgUserPostLastUpdate}
<dd .deflist__dd>
^{formatTimeW SelFormatDateTime postUpdate}
$if (not postalAutomatic)
$maybe postUpdate <- userPostLastUpdate
<dt .deflist__dt>
_{MsgUserPostLastUpdate}
<dd .deflist__dd>
^{formatTimeW SelFormatDateTime postUpdate}
<dt .deflist__dt>
_{MsgUserDisplayEmail}
<dd .deflist__dd .email>
#{mailtoHtml userDisplayEmail}
$if not (validEmail' userDisplayEmail)
\ ^{messageTooltip tooltipInvalidEmail}
$if userEmail /= userDisplayEmail
$maybe primaryEmail <- actualDisplayEmail
#{isAutomatic emailAutomatic} #
#{mailtoHtml primaryEmail}
$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>

24
test/Database/Fill.hs
View File

@ -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 svaupel nice True False
void . insert' $ UserCompany gkleen nice False False
void . insert' $ UserCompany gkleen fraGround False True
void . insert' $ UserCompany fhamann bpol False False
void . insert' $ UserCompany fhamann ffacil True True
void . insert' $ UserCompany fhamann nice False False
void . insert' $ UserCompany jost fraportAg True True 0 False
void . insert' $ UserCompany svaupel nice True False 0 False
void . insert' $ UserCompany gkleen nice False False 1 True
void . insert' $ UserCompany gkleen fraGround False True 2 False
void . insert' $ UserCompany fhamann bpol False False 1 True
void . insert' $ UserCompany fhamann ffacil True True 2 True
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 bpol False 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 ffacil False False| Entity uid User{userSurname = "Walker"} <- matUsers]
insertMany_ [UserCompany uid rckey issuper False
insertMany_ [UserCompany uid fraGround False False 0 True | Entity uid User{userFirstName = "John"} <- matUsers]
insertMany_ [UserCompany uid bpol False False 0 False | Entity uid User{userFirstName = "Elizabeth"} <- matUsers]
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 0 False | Entity uid User{userSurname = "Walker"} <- matUsers]
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