fraport/fradrive-old
Archived
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases 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 -- update company association & supervision
Entity{entityKey=newCompanyId} <- upsertAvsCompany newAvsFirmInfo oldAvsFirmInfo newCompanyEnt@Entity{entityKey=newCompanyId} <- upsertAvsCompany newAvsFirmInfo oldAvsFirmInfo
oldCompanyEnt <- getAvsCompany `traverseJoin` oldAvsFirmInfo oldCompanyEnt <- getAvsCompany `traverseJoin` oldAvsFirmInfo
primaryCompanyId <- userCompanyCompany <<$>> getUserPrimaryCompany usrId primaryCompanyId <- userCompanyCompany <<$>> getUserPrimaryCompany usrId
let oldCompanyId = entityKey <$> oldCompanyEnt let oldCompanyId = entityKey <$> oldCompanyEnt
@ -445,6 +445,7 @@ updateAvsUserByADC newAvsDataContact@(AvsDataContact apid newAvsPersonInfo newAv
-- newAPs <- count $ (UserSupervisorUser ==. usrId) : (UserSupervisorCompany ==. Just newCompanyId) : (UserSupervisorReason ~=. superReasonComDef) -- newAPs <- count $ (UserSupervisorUser ==. usrId) : (UserSupervisorCompany ==. Just newCompanyId) : (UserSupervisorReason ~=. superReasonComDef)
-- when (oldAPs > 0 && newAPs <= 0) $ reportAdminProblem $ AdminProblemNewlyUnsupervised usrId oldCompanyId newCompanyId -- when (oldAPs > 0 && newAPs <= 0) $ reportAdminProblem $ AdminProblemNewlyUnsupervised usrId oldCompanyId newCompanyId
-- return pst_up -- 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_up2 -- update user by company switch first (due to possible conflicts with usr_up2)
update usrId usr_up1 -- update user eventually update usrId usr_up1 -- update user eventually
update uaId avs_ups -- update stored avsinfo for future updates 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 upsertAvsCompany newAvsFirmInfo mbOldAvsFirmInfo = do
mbFirmEnt <- getAvsCompany newAvsFirmInfo -- primarily by AvsId, then Shorthand, then name mbFirmEnt <- getAvsCompany newAvsFirmInfo -- primarily by AvsId, then Shorthand, then name
$logInfoS "AVS" [st|upsertAvsCompany: old #{tshow mbFirmEnt} new #{tshow newAvsFirmInfo}|] $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 (Nothing, _) -> do -- insert new company, neither AvsId nor Shorthand exist in DB
afn <- if 0 < newAvsFirmInfo ^. _avsFirmFirmNo afn <- if 0 < newAvsFirmInfo ^. _avsFirmFirmNo
then return $ newAvsFirmInfo ^. _avsFirmFirmNo then return $ newAvsFirmInfo ^. _avsFirmFirmNo
@ -630,8 +631,6 @@ upsertAvsCompany newAvsFirmInfo mbOldAvsFirmInfo = do
_otherwise -> return res_cmp _otherwise -> return res_cmp
$logInfoS "AVS" "Update company completed." $logInfoS "AVS" "Update company completed."
return res_cmp2 return res_cmp2
void $ upsertCompanySuperior cmpEnt newAvsFirmInfo mbOldAvsFirmInfo -- ensure firmInfo superior is supervisor
return cmpEnt
where where
firmInfo2key = firmInfo2key =
CheckUpdate CompanyShorthand $ _avsFirmAbbreviation . from _CI -- Updating primary key works in principle thanks to OnUpdateCascade, but fails due to update get 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 -- , 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 -- | adjust superiors, assumes that CompanyUser exists for all usrs for given company; does not work otherwise
upsertCompanySuperior Entity{entityKey=cid, entityVal=Company{}} newAfi oldAfi = 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 let reasonSuperior = Just $ tshow SupervisorReasonAvsSuperior
getInsertUid eml = altM (guessUserByEmail $ stripCI eml) (catchAll2log' $ Just . entityKey <$> ldapLookupAndUpsert eml) getInsertUid eml = altM (guessUserByEmail $ stripCI eml) (catchAll2log' $ Just . entityKey <$> ldapLookupAndUpsert eml)
newAvsNo = newAfi ^. _avsFirmFirmNo 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 -- 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 -- 2. unchangedCompany && not changedSuperior: superior must already been set, short-circuit
-- 3. unchangedCompany && changedSuperior: update superior for all users -- 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 mbSupId <- getSupId
-- delete old superiors, if any -- delete old superiors, if any
when (unchangedCompany && changedSuperior) $ when (unchangedCompany && changedSuperior) $
deleteWhere $ mcons ((UserSupervisorSupervisor !=.) <$> mbSupId) deleteWhere $ mcons ((UserSupervisorSupervisor !=.) <$> mbSupId)
[ UserSupervisorCompany ==. Just cid, UserSupervisorReason ==. reasonSuperior ] [ UserSupervisorCompany ==. Just cid, UserSupervisorReason ==. reasonSuperior ]
unless unchangedCompany $
deleteWhere [ UserSupervisorReason ==. reasonSuperior, UserSupervisorUser <-. usrs ]
-- ensure superior supervision -- ensure superior supervision
case mbSupId of case mbSupId of
Just supId -> do Just supId -> do
-- ensure association between company and superior at equal-to-top priority -- ensure association between company and superior at equal-to-top priority
prio <- getCompanyUserMaxPrio supId 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 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 -- ensure all company associates are irregularly supervised by the superior
E.insertSelectWithConflict UniqueUserSupervisor E.insertSelectWithConflict UniqueUserSupervisor
(do (do
@ -704,7 +707,6 @@ upsertCompanySuperior Entity{entityKey=cid, entityVal=Company{}} newAfi oldAfi =
oldSupId <- getOldId oldSupId <- getOldId
reportAdminProblem $ AdminProblemCompanySuperiorNotFound mbSupEmail cid oldSupId reportAdminProblem $ AdminProblemCompanySuperiorNotFound mbSupEmail cid oldSupId
queueAvsUpdateByUID :: (MonoFoldable mono, UserId ~ Element mono) => mono -> Maybe Day -> DB Int64 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) queueAvsUpdateByUID uids = queueAvsUpdateAux (E.table @User) (E.^. UserId) (\usr -> usr E.^. UserId `E.in_` E.vals uids)