fraport/fradrive-old
fraport/fradrive-old
Archived
3
1
Fork 0
Code Issues 65 Pull Requests 5 Actions Packages Projects Releases 197 Wiki Activity

fix(avs): fix #178 by deleting old superiors for individual users

Browse Source
This commit is contained in:
Steffen Jost 2024-09-05 17:53:18 +02:00
parent cbadef0a73
commit ade27e6479
1 changed files with 11 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -381,7 +381,7 @@ updateAvsUserByADC newAvsDataContact@(AvsDataContact apid newAvsPersonInfo newAv
]
-- update company association & supervision
Entity{entityKey=newCompanyId} <- upsertAvsCompany newAvsFirmInfo oldAvsFirmInfo
newCompanyEnt@Entity{entityKey=newCompanyId} <- upsertAvsCompany newAvsFirmInfo oldAvsFirmInfo
oldCompanyEnt <- getAvsCompany `traverseJoin` oldAvsFirmInfo
primaryCompanyId <- userCompanyCompany <<$>> getUserPrimaryCompany usrId
let oldCompanyId = entityKey <$> oldCompanyEnt
@ -445,6 +445,7 @@ updateAvsUserByADC newAvsDataContact@(AvsDataContact apid newAvsPersonInfo newAv
-- newAPs <- count $ (UserSupervisorUser ==. usrId) : (UserSupervisorCompany ==. Just newCompanyId) : (UserSupervisorReason ~=. superReasonComDef)
-- when (oldAPs > 0 && newAPs <= 0) $ reportAdminProblem $ AdminProblemNewlyUnsupervised usrId oldCompanyId newCompanyId
-- return pst_up
upsertCompanySuperior newCompanyEnt newAvsFirmInfo oldAvsFirmInfo [usrId] -- ensure firmInfo superior is supervisor for this user
update usrId usr_up2 -- update user by company switch first (due to possible conflicts with usr_up2)
update usrId usr_up1 -- update user eventually
update uaId avs_ups -- update stored avsinfo for future updates
@ -587,7 +588,7 @@ upsertAvsCompany :: AvsFirmInfo -> Maybe AvsFirmInfo -> DB (Entity Company)
upsertAvsCompany newAvsFirmInfo mbOldAvsFirmInfo = do
mbFirmEnt <- getAvsCompany newAvsFirmInfo -- primarily by AvsId, then Shorthand, then name
$logInfoS "AVS" [st|upsertAvsCompany: old #{tshow mbFirmEnt} new #{tshow newAvsFirmInfo}|]
cmpEnt <- case (mbFirmEnt, mbOldAvsFirmInfo) of
case (mbFirmEnt, mbOldAvsFirmInfo) of
(Nothing, _) -> do -- insert new company, neither AvsId nor Shorthand exist in DB
afn <- if 0 < newAvsFirmInfo ^. _avsFirmFirmNo
then return $ newAvsFirmInfo ^. _avsFirmFirmNo
@ -630,8 +631,6 @@ upsertAvsCompany newAvsFirmInfo mbOldAvsFirmInfo = do
_otherwise -> return res_cmp
$logInfoS "AVS" "Update company completed."
return res_cmp2
void $ upsertCompanySuperior cmpEnt newAvsFirmInfo mbOldAvsFirmInfo -- ensure firmInfo superior is supervisor
return cmpEnt
where
firmInfo2key =
CheckUpdate CompanyShorthand $ _avsFirmAbbreviation . from _CI -- Updating primary key works in principle thanks to OnUpdateCascade, but fails due to update get
@ -644,9 +643,10 @@ upsertAvsCompany newAvsFirmInfo mbOldAvsFirmInfo = do
-- , CheckUpdate CompanyPrefersPostal _avsFirmPrefersPostal -- Guessing here is not useful, since postal preference is ignored anyway when there is only one option available
]
-- upsert company supervisor from AvsFirmEMailSuperior
upsertCompanySuperior :: Entity Company -> AvsFirmInfo -> Maybe AvsFirmInfo -> DB () -- (Maybe UserId) possibly return superior, but currently not needed
upsertCompanySuperior Entity{entityKey=cid, entityVal=Company{}} newAfi oldAfi =
-- | adjust superiors, assumes that CompanyUser exists for all usrs for given company; does not work otherwise
upsertCompanySuperior :: Entity Company -> AvsFirmInfo -> Maybe AvsFirmInfo -> [UserId] -> DB () -- may return superior (Maybe UserId), but currently not needed
upsertCompanySuperior Entity{entityKey=cid, entityVal=Company{}} newAfi oldAfi usrs =
let reasonSuperior = Just $ tshow SupervisorReasonAvsSuperior
getInsertUid eml = altM (guessUserByEmail $ stripCI eml) (catchAll2log' $ Just . entityKey <$> ldapLookupAndUpsert eml)
newAvsNo = newAfi ^. _avsFirmFirmNo
@ -660,18 +660,21 @@ upsertCompanySuperior Entity{entityKey=cid, entityVal=Company{}} newAfi oldAfi =
-- 1. not unchangedCompany: do not delete, but ensure that superior supervision is set, since it could be a just a single user company change
-- 2. unchangedCompany && not changedSuperior: superior must already been set, short-circuit
-- 3. unchangedCompany && changedSuperior: update superior for all users
in unless (unchangedCompany && not changedSuperior && False) $ do -- TODO: from 2025 onwards, once superiors are sufficently update, do nothing if (unchangedCompany && not changedSuperior).
in unless (unchangedCompany && not changedSuperior) $ do -- do nothing if (unchangedCompany && not changedSuperior).
mbSupId <- getSupId
-- delete old superiors, if any
when (unchangedCompany && changedSuperior) $
deleteWhere $ mcons ((UserSupervisorSupervisor !=.) <$> mbSupId)
[ UserSupervisorCompany ==. Just cid, UserSupervisorReason ==. reasonSuperior ]
unless unchangedCompany $
deleteWhere [ UserSupervisorReason ==. reasonSuperior, UserSupervisorUser <-. usrs ]
-- ensure superior supervision
case mbSupId of
Just supId -> do
-- ensure association between company and superior at equal-to-top priority
prio <- getCompanyUserMaxPrio supId
void $ insertUnique (UserCompany supId cid False False prio True reasonSuperior) -- superior is not a supervisor, do not change existing user company associations
-- ensure all company associates are irregularly supervised by the superior
E.insertSelectWithConflict UniqueUserSupervisor
(do
@ -704,7 +707,6 @@ upsertCompanySuperior Entity{entityKey=cid, entityVal=Company{}} newAfi oldAfi =
oldSupId <- getOldId
reportAdminProblem $ AdminProblemCompanySuperiorNotFound mbSupEmail cid oldSupId
queueAvsUpdateByUID :: (MonoFoldable mono, UserId ~ Element mono) => mono -> Maybe Day -> DB Int64
queueAvsUpdateByUID uids = queueAvsUpdateAux (E.table @User) (E.^. UserId) (\usr -> usr E.^. UserId `E.in_` E.vals uids)