fix(avs): update email on manual company switch

towards #164
This commit is contained in:
Steffen Jost 2024-06-11 12:12:56 +02:00
parent ac3271242d
commit 9fd80f2552
3 changed files with 13 additions and 10 deletions

View File

@ -78,20 +78,23 @@ addCompanySupervisors cid uid =
-- | removes user supervisorship on switch. WARNING: problems are not yet written to DB via reportProblem yet
switchAvsUserCompany :: Bool -> Bool -> UserId -> CompanyId -> DB ([Update User], [AdminProblem])
switchAvsUserCompany usrPostAddrUpd keepOldCompanySupervs uid newCompanyId = do
switchAvsUserCompany usrPostEmailUpds keepOldCompanySupervs uid newCompanyId = do
usrRec <- get404 uid
newCompany <- get404 newCompanyId
mbUsrComp <- getUserPrimaryCompany uid
mbOldComp <- (get . userCompanyCompany) `traverseJoin` mbUsrComp
mbUsrAvs <- if usrPostAddrUpd then getBy (UniqueUserAvsUser uid) else return Nothing
mbUsrAvs <- if usrPostEmailUpds then getBy (UniqueUserAvsUser uid) else return Nothing
let usrPostAddr :: Maybe StoredMarkup = userPostAddress usrRec
avsPostAddr :: Maybe StoredMarkup = mbUsrAvs ^? _Just . _entityVal . _userAvsLastFirmInfo . _Just . _avsFirmPostAddress . _Just
usrPostUp = toMaybe (usrPostAddrUpd && fromMaybe False (liftA2 isSimilarMarkup usrPostAddr avsPostAddr))
usrPostUp = toMaybe (usrPostEmailUpds && fromMaybe False (liftA2 isSimilarMarkup usrPostAddr avsPostAddr))
(UserPostAddress =. Nothing) -- use company address indirectyl instead
usrPrefPost = userPrefersPostal usrRec
usrPrefPostUp = toMaybe (Just usrPrefPost == (mbOldComp ^? _Just . _companyPrefersPostal))
(UserPrefersPostal =. companyPrefersPostal newCompany)
usrUpdate = catMaybes [usrPostUp, usrPrefPostUp]
usrEmail :: UserEmail = userDisplayEmail usrRec
avsEmail :: Maybe UserEmail = mbUsrAvs ^? _Just . _entityVal . _userAvsLastFirmInfo . _Just . _avsFirmPrimaryEmail . _Just . from _CI
usrEmailUp = toMaybe (usrPostEmailUpds && avsEmail == Just usrEmail) (UserDisplayEmail =. "")
usrUpdate = catMaybes [usrPostUp, usrPrefPostUp, usrEmailUp]
-- [UserPostAddress =. Nothing, UserPrefersPostal =. companyPrefersPostal newCompany] -- unconditional
-- update uid usrUpdate
-- repsertSuperiorSupervisor is not called here, since the Superior is indepentent of the actual company association

View File

@ -152,8 +152,8 @@ getUserEmailAutomatic Entity{entityKey=uid, entityVal=User{userDisplayEmail, use
-- address is prefixed with userDisplayName
getPostalAddress :: Entity User -> DB (Maybe [Text])
getPostalAddress Entity{entityKey=uid, entityVal=User{..}}
| Just pa <- userPostAddress
= prefixMarkupName pa
| (Just upo) <- userPostAddress, validPostAddress userPostAddress
= prefixMarkupName upo
| otherwise
= do
getUserPrimaryCompanyAddress uid companyPostAddress >>= \case
@ -170,11 +170,11 @@ getPostalAddress Entity{entityKey=uid, entityVal=User{..}}
-- primed variant returns storedMarkup without prefixed userDisplayName and whether updates are automatic
getPostalAddress' :: Entity User -> DB (Maybe StoredMarkup, Bool)
getPostalAddress' Entity{entityKey=uid, entityVal=User{..}}
| res@(Just upo) <- userPostAddress
| validPostAddress userPostAddress
= do
muavs <- getBy $ UniqueUserAvsUser uid
let auto = upo == muavs ^. _Just . _userAvsLastFirmInfo . _Just . _avsFirmPostAddress . _Just -- Recall: _Just on Nothing yields mempty here
return (res, auto)
let auto = userPostAddress == muavs ^? _Just . _userAvsLastFirmInfo . _Just . _avsFirmPostAddress . _Just -- Recall: using _Just with ^. on Nothing yields mempty
return (userPostAddress, auto)
| otherwise
= do
getUserPrimaryCompanyAddress uid companyPostAddress >>= \case

View File

@ -658,7 +658,7 @@ _avsFirmPrimaryEmail = to mkEmail
mkEmail afi =
let candidates = catMaybes
[ afi ^. _avsFirmCommunication . _Just . _avsCommunicationEMail
, afi ^. _avsFirmEMailSuperior
, afi ^. _avsFirmEMailSuperior -- only set for Fraport departments, hence this is a non-personal department wide email suitable as company email
, afi ^. _avsFirmEMail
]
in pickValidEmail candidates -- should we return an invalid email rather than none?