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

chore(avs): prepare superior update shortcircuit for future

Browse Source
This commit is contained in:
Steffen Jost 2024-09-02 09:08:44 +02:00
parent 7e5c256b4c
commit 1e896da4a3
1 changed files with 47 additions and 43 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -646,7 +646,7 @@ upsertAvsCompany newAvsFirmInfo mbOldAvsFirmInfo = do
-- 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 = do
upsertCompanySuperior Entity{entityKey=cid, entityVal=Company{}} newAfi oldAfi =
let reasonSuperior = Just $ tshow SupervisorReasonAvsSuperior
getInsertUid eml = altM (guessUserByEmail $ stripCI eml) (catchAll2log' $ Just . entityKey <$> ldapLookupAndUpsert eml)
newAvsNo = newAfi ^. _avsFirmFirmNo
@ -657,48 +657,52 @@ upsertCompanySuperior Entity{entityKey=cid, entityVal=Company{}} newAfi oldAfi =
getOldId = (guessUserByEmail . stripCI) `traverseJoin` mbOldEmail
unchangedCompany = oldAvsNo == Just newAvsNo
changedSuperior = mbSupEmail /= mbOldEmail -- beware, both could be Nothing
mbSupId <- getSupId
-- delete old superiors, if any
when (unchangedCompany && changedSuperior) $
deleteWhere $ mcons ((UserSupervisorSupervisor !=.) <$> mbSupId)
[ UserSupervisorCompany ==. Just cid, UserSupervisorReason ==. reasonSuperior ]
-- 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
usr <- E.from $ E.table @UserCompany
E.where_ $ usr E.^. UserCompanyCompany E.==. E.val cid
-- E.&&. E.notExists (do -- restrict to primary company only
-- othr <- E.from $ E.table @UserCompany
-- E.where_ $ othr E.^. UserCompanyPriority E.>. usr E.^. UserCompanyPriority
-- E.&&. othr E.^. UserCompanyUser E.==. usr E.^. UserCompanyUser
-- E.&&. othr E.^. UserCompanyCompany E.!=. E.val cid -- redundant due to > above, but likely performance improving
-- )
return $ UserSupervisor
E.<# E.val supId
E.<&> (usr E.^. UserCompanyUser)
E.<&> E.false
E.<&> E.justVal cid
E.<&> E.val reasonSuperior
)
(\_old _new -> [] -- do not change exisitng supervision
-- [ UserSupervisorCompany E.=. new E.^. UserSupervisorCompany
-- , UserSupervisorReason E.=. new E.^. UserSupervisorReason
-- , UserSupervisorRerouteNotifications E.=. new E.^. UserSupervisorRerouteNotifications
-- ]
)
when (unchangedCompany && changedSuperior) $ do
oldSupId <- getOldId
reportAdminProblem $ AdminProblemCompanySuperiorChange supId cid oldSupId
Nothing ->
when (unchangedCompany && changedSuperior) $ do
oldSupId <- getOldId
reportAdminProblem $ AdminProblemCompanySuperiorNotFound mbSupEmail cid oldSupId
-- 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).
mbSupId <- getSupId
-- delete old superiors, if any
when (unchangedCompany && changedSuperior) $
deleteWhere $ mcons ((UserSupervisorSupervisor !=.) <$> mbSupId)
[ UserSupervisorCompany ==. Just cid, UserSupervisorReason ==. reasonSuperior ]
-- 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
usr <- E.from $ E.table @UserCompany
E.where_ $ usr E.^. UserCompanyCompany E.==. E.val cid
-- E.&&. E.notExists (do -- restrict to primary company only
-- othr <- E.from $ E.table @UserCompany
-- E.where_ $ othr E.^. UserCompanyPriority E.>. usr E.^. UserCompanyPriority
-- E.&&. othr E.^. UserCompanyUser E.==. usr E.^. UserCompanyUser
-- E.&&. othr E.^. UserCompanyCompany E.!=. E.val cid -- redundant due to > above, but likely performance improving
-- )
return $ UserSupervisor
E.<# E.val supId
E.<&> (usr E.^. UserCompanyUser)
E.<&> E.false
E.<&> E.justVal cid
E.<&> E.val reasonSuperior
)
(\_old _new -> [] -- do not change exisitng supervision
-- [ UserSupervisorCompany E.=. new E.^. UserSupervisorCompany
-- , UserSupervisorReason E.=. new E.^. UserSupervisorReason
-- , UserSupervisorRerouteNotifications E.=. new E.^. UserSupervisorRerouteNotifications
-- ]
)
when (unchangedCompany && changedSuperior) $ do
oldSupId <- getOldId
reportAdminProblem $ AdminProblemCompanySuperiorChange supId cid oldSupId
Nothing ->
when (unchangedCompany && changedSuperior) $ do
oldSupId <- getOldId
reportAdminProblem $ AdminProblemCompanySuperiorNotFound mbSupEmail cid oldSupId
queueAvsUpdateByUID :: (MonoFoldable mono, UserId ~ Element mono) => mono -> Maybe Day -> DB Int64