From 1e896da4a34102242015e72930979aede389ccbf Mon Sep 17 00:00:00 2001 From: Steffen Date: Mon, 2 Sep 2024 09:08:44 +0200 Subject: [PATCH] chore(avs): prepare superior update shortcircuit for future --- src/Handler/Utils/Avs.hs | 90 +++++++++++++++++++++------------------- 1 file changed, 47 insertions(+), 43 deletions(-) diff --git a/src/Handler/Utils/Avs.hs b/src/Handler/Utils/Avs.hs index 292fad0df..a4f28a9a8 100644 --- a/src/Handler/Utils/Avs.hs +++ b/src/Handler/Utils/Avs.hs @@ -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