fraport/fradrive-old
Archived
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 -- upsert company supervisor from AvsFirmEMailSuperior
upsertCompanySuperior :: Entity Company -> AvsFirmInfo -> Maybe AvsFirmInfo -> DB () -- (Maybe UserId) possibly return superior, but currently not needed 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 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
@ -657,48 +657,52 @@ upsertCompanySuperior Entity{entityKey=cid, entityVal=Company{}} newAfi oldAfi =
getOldId = (guessUserByEmail . stripCI) `traverseJoin` mbOldEmail getOldId = (guessUserByEmail . stripCI) `traverseJoin` mbOldEmail
unchangedCompany = oldAvsNo == Just newAvsNo unchangedCompany = oldAvsNo == Just newAvsNo
changedSuperior = mbSupEmail /= mbOldEmail -- beware, both could be Nothing changedSuperior = mbSupEmail /= mbOldEmail -- beware, both could be Nothing
mbSupId <- getSupId -- 1. not unchangedCompany: do not delete, but ensure that superior supervision is set, since it could be a just a single user company change
-- delete old superiors, if any -- 2. unchangedCompany && not changedSuperior: superior must already been set, short-circuit
when (unchangedCompany && changedSuperior) $ -- 3. unchangedCompany && changedSuperior: update superior for all users
deleteWhere $ mcons ((UserSupervisorSupervisor !=.) <$> mbSupId) in unless (unchangedCompany && not changedSuperior && False) $ do -- TODO: from 2025 onwards, once superiors are sufficently update, do nothing if (unchangedCompany && not changedSuperior).
[ UserSupervisorCompany ==. Just cid, UserSupervisorReason ==. reasonSuperior ] mbSupId <- getSupId
-- ensure superior supervision -- delete old superiors, if any
case mbSupId of when (unchangedCompany && changedSuperior) $
Just supId -> do deleteWhere $ mcons ((UserSupervisorSupervisor !=.) <$> mbSupId)
-- ensure association between company and superior at equal-to-top priority [ UserSupervisorCompany ==. Just cid, UserSupervisorReason ==. reasonSuperior ]
prio <- getCompanyUserMaxPrio supId -- ensure superior supervision
void $ insertUnique (UserCompany supId cid False False prio True reasonSuperior) -- superior is not a supervisor, do not change existing user company associations case mbSupId of
-- ensure all company associates are irregularly supervised by the superior Just supId -> do
E.insertSelectWithConflict UniqueUserSupervisor -- ensure association between company and superior at equal-to-top priority
(do prio <- getCompanyUserMaxPrio supId
usr <- E.from $ E.table @UserCompany void $ insertUnique (UserCompany supId cid False False prio True reasonSuperior) -- superior is not a supervisor, do not change existing user company associations
E.where_ $ usr E.^. UserCompanyCompany E.==. E.val cid -- ensure all company associates are irregularly supervised by the superior
-- E.&&. E.notExists (do -- restrict to primary company only E.insertSelectWithConflict UniqueUserSupervisor
-- othr <- E.from $ E.table @UserCompany (do
-- E.where_ $ othr E.^. UserCompanyPriority E.>. usr E.^. UserCompanyPriority usr <- E.from $ E.table @UserCompany
-- E.&&. othr E.^. UserCompanyUser E.==. usr E.^. UserCompanyUser E.where_ $ usr E.^. UserCompanyCompany E.==. E.val cid
-- E.&&. othr E.^. UserCompanyCompany E.!=. E.val cid -- redundant due to > above, but likely performance improving -- E.&&. E.notExists (do -- restrict to primary company only
-- ) -- othr <- E.from $ E.table @UserCompany
return $ UserSupervisor -- E.where_ $ othr E.^. UserCompanyPriority E.>. usr E.^. UserCompanyPriority
E.<# E.val supId -- E.&&. othr E.^. UserCompanyUser E.==. usr E.^. UserCompanyUser
E.<&> (usr E.^. UserCompanyUser) -- E.&&. othr E.^. UserCompanyCompany E.!=. E.val cid -- redundant due to > above, but likely performance improving
E.<&> E.false -- )
E.<&> E.justVal cid return $ UserSupervisor
E.<&> E.val reasonSuperior E.<# E.val supId
) E.<&> (usr E.^. UserCompanyUser)
(\_old _new -> [] -- do not change exisitng supervision E.<&> E.false
-- [ UserSupervisorCompany E.=. new E.^. UserSupervisorCompany E.<&> E.justVal cid
-- , UserSupervisorReason E.=. new E.^. UserSupervisorReason E.<&> E.val reasonSuperior
-- , UserSupervisorRerouteNotifications E.=. new E.^. UserSupervisorRerouteNotifications )
-- ] (\_old _new -> [] -- do not change exisitng supervision
) -- [ UserSupervisorCompany E.=. new E.^. UserSupervisorCompany
when (unchangedCompany && changedSuperior) $ do -- , UserSupervisorReason E.=. new E.^. UserSupervisorReason
oldSupId <- getOldId -- , UserSupervisorRerouteNotifications E.=. new E.^. UserSupervisorRerouteNotifications
reportAdminProblem $ AdminProblemCompanySuperiorChange supId cid oldSupId -- ]
Nothing -> )
when (unchangedCompany && changedSuperior) $ do when (unchangedCompany && changedSuperior) $ do
oldSupId <- getOldId oldSupId <- getOldId
reportAdminProblem $ AdminProblemCompanySuperiorNotFound mbSupEmail cid oldSupId 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 queueAvsUpdateByUID :: (MonoFoldable mono, UserId ~ Element mono) => mono -> Maybe Day -> DB Int64