From b4f3171257414605d555e351df02a257e25a1fa2 Mon Sep 17 00:00:00 2001 From: Steffen Jost Date: Thu, 13 Feb 2025 17:26:10 +0100 Subject: [PATCH] chore(avs): add debug log info after not finding an error in company supervision switching after avs update --- src/Handler/Utils/Avs.hs | 24 ++++++++++++++---------- src/Handler/Utils/Company.hs | 26 ++++++++++++++++++-------- src/Handler/Utils/Users.hs | 7 +++---- 3 files changed, 35 insertions(+), 22 deletions(-) diff --git a/src/Handler/Utils/Avs.hs b/src/Handler/Utils/Avs.hs index 5f9d44717..bf7c35b34 100644 --- a/src/Handler/Utils/Avs.hs +++ b/src/Handler/Utils/Avs.hs @@ -411,26 +411,29 @@ updateAvsUserByADC newAvsDataContact@(AvsDataContact apid newAvsPersonInfo newAv base_up :: [Update User] base_up = guardMonoid (newCompanyEnt ^. _entityVal . _companyPinPassword) (maybeToList pin_up0) - case oldAvsFirmInfo of _ | Just newCompanyId == oldCompanyId -- company unchanged entirely - -> return base_up -- => do nothing + -> do -- => do nothing + $logInfoS "Supervision" [st|updateAvsUserByADC for #{tshow usrId} to new company #{unCompanyKey newCompanyId} from old company #{oldCompanyId} having primary company #{primaryCompanyId}. Company id unchanged.|] + return base_up (Just oafi) | isJust (view _avsFirmPostAddressSimple oafi) && ((==) `on` view _avsFirmPostAddressSimple) oafi newAvsFirmInfo -- non-empty company address unchanged OR || isJust (view _avsFirmPrimaryEmail oafi) && ((==) `on` view _avsFirmPrimaryEmail) oafi newAvsFirmInfo -- non-empty company primary email unchanged -> do -- => just update user company association, keeping supervision privileges + $logInfoS "Supervision" [st|updateAvsUserByADC for #{tshow usrId} to new company #{unCompanyKey newCompanyId} from old company #{oldCompanyId} having primary company #{primaryCompanyId}. Company address unchanged, just updating.|] case oldCompanyId of Nothing -> void $ insertUnique newUserComp -- it's ok if this already exists Just ocid -> do void $ upsertBySafe (UniqueUserCompany usrId ocid) newUserComp (_userCompanyCompany .~ newCompanyId) -- keep default supervisor settings void $ updateWhere [ UserSupervisorSupervisor ==. usrId -- update company-related supervisions - , UserSupervisorCompany ==. Just ocid -- to new company, regardless of - , UserSupervisorReason ==. Just superReasonComDef] -- user - [ UserSupervisorCompany =. Just newCompanyId] + , UserSupervisorCompany ==. Just ocid -- to new company, regardless of + , UserSupervisorReason ==. Just superReasonComDef] -- user + [ UserSupervisorCompany =. Just newCompanyId] return base_up _ | Just newCompanyId == primaryCompanyId -- old primaryCompany is now also AVS-company -> do + $logInfoS "Supervision" [st|updateAvsUserByADC for #{tshow usrId} to new company #{unCompanyKey newCompanyId} from old company #{oldCompanyId} having primary company #{primaryCompanyId}. Primary company unchanged.|] whenIsJust oldCompanyId $ \oldCid -> do deleteBy $ UniqueUserCompany usrId oldCid deleteWhere $ (UserSupervisorUser ==. usrId):(UserSupervisorCompany ==. oldCompanyId):(UserSupervisorReason ~=. superReasonComDef) @@ -438,6 +441,7 @@ updateAvsUserByADC newAvsDataContact@(AvsDataContact apid newAvsPersonInfo newAv _ -- company changed completely -> do (pst_up, problems) <- switchAvsUserCompany False False usrId newCompanyId + $logInfoS "Supervision" [st|updateAvsUserByADC for #{tshow usrId} to new company #{unCompanyKey newCompanyId} from old company #{oldCompanyId} having primary company #{primaryCompanyId}. Company switched. #{length pst_up} updates. #{length problems} problems.|] mapM_ reportAdminProblem problems -- Following line does not type, hence additional parameter needed -- return [ u | u@Update{updateField=f} <- pst_up, f /= UserPostAddress ] -- already computed in frm_up above, duplicate update must be prevented (version above accounts for legacy updates) @@ -715,11 +719,11 @@ upsertCompanySuperior Entity{entityKey=cid, entityVal=Company{}} newAfi oldAfi u 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 - -- ] + (\_old new -> + [ UserSupervisorCompany E.=. new E.^. UserSupervisorCompany + , UserSupervisorReason E.=. new E.^. UserSupervisorReason + , UserSupervisorRerouteNotifications E.=. new E.^. UserSupervisorRerouteNotifications + ] ) when (unchangedCompany && changedSuperior) $ do oldSupId <- getOldId diff --git a/src/Handler/Utils/Company.hs b/src/Handler/Utils/Company.hs index 27e554164..58276cdb4 100644 --- a/src/Handler/Utils/Company.hs +++ b/src/Handler/Utils/Company.hs @@ -38,6 +38,11 @@ instance E.SqlString (Key Company) company2msg :: CompanyId -> SomeMessage UniWorX company2msg = text2message . ciOriginal . unCompanyKey +-- for convenience in debugging +instance ToText (Maybe CompanyId) where + toText Nothing = toText ("-None-"::Text) + toText (Just fsh) = toText $ unCompanyKey fsh + wgtCompanies :: Bool -> UserId -> DB (Maybe Widget) wgtCompanies useShort = (wrapUL . fst <<$>>) . wgtCompanies' useShort where @@ -104,7 +109,8 @@ addDefaultSupervisors reason cid employees = do [ UserSupervisorRerouteNotifications E.=. new E.^. UserSupervisorRerouteNotifications , UserSupervisorCompany E.=. E.justVal cid , UserSupervisorReason E.=. E.coalesce [new E.^. UserSupervisorReason, old E.^. UserSupervisorReason] -- keep existing reason, if no new one was given - ]) + ] + ) -- like `Handler.Utils.addDefaultSupervisors`, but selects all employees of given companies from database, optionally filtered by being under supervision of a given individual @@ -164,7 +170,7 @@ addDefaultSupervisorsAll reason mutualSupervision cids = do , UserSupervisorReason E.=. E.coalesce [old E.^. UserSupervisorReason, new E.^. UserSupervisorReason] -- keep any existing reason ] ) --- | removes user supervisorship on switch. WARNING: problems are not yet written to DB via reportProblem yet +-- | removes user supervisorship on switch. WARNING: problems are only returned, but not yet written to DB via reportProblem switchAvsUserCompany :: Bool -> Bool -> UserId -> CompanyId -> DB ([Update User], [AdminProblem]) switchAvsUserCompany usrPostEmailUpds keepOldCompanySupervs uid newCompanyId = do usrRec <- get404 uid @@ -193,14 +199,16 @@ switchAvsUserCompany usrPostEmailUpds keepOldCompanySupervs uid newCompanyId = d case mbUsrComp of Nothing -> do -- create company user void $ insertUnique newUserComp - void $ addDefaultSupervisors Nothing newCompanyId $ singleton uid + newAPs <- addDefaultSupervisors' newCompanyId $ singleton uid + $logInfoS "Supervision" [st|switchAvsUserCompany for #{tshow uid} to #{unCompanyKey newCompanyId}. #{newAPs} default company supervisors upserted.|] return (usrUpdate, mempty) Just UserCompany{userCompanyCompany=oldCompanyId, userCompanyPriority=oldPrio, userCompanySupervisor=oldSuper, userCompanySupervisorReroute=oldSuperReroute, userCompanyReason=oldAssocReason} | newCompanyId == oldCompanyId -> return mempty -- nothing to do | otherwise -> do -- switch company when (isNothing oldAssocReason) $ deleteBy $ UniqueUserCompany uid oldCompanyId - void $ upsertBy (UniqueUserCompany uid newCompanyId) newUserComp{userCompanyPriority = succ oldPrio} - [UserCompanyPriority =. succ oldPrio, UserCompanySupervisor =. False, UserCompanySupervisorReroute =. False, UserCompanyUseCompanyAddress =. True, UserCompanyReason =. Nothing] + let newPrio = succ oldPrio + void $ upsertBy (UniqueUserCompany uid newCompanyId) newUserComp{userCompanyPriority = newPrio} + [UserCompanyPriority =. newPrio, UserCompanySupervisor =. False, UserCompanySupervisorReroute =. False, UserCompanyUseCompanyAddress =. True, UserCompanyReason =. Nothing] -- supervised by uid supervisees :: [(Entity UserSupervisor, E.Value Bool)] <- E.select $ do usrSup <- E.from $ E.table @UserSupervisor @@ -220,17 +228,19 @@ switchAvsUserCompany usrPostEmailUpds keepOldCompanySupervs uid newCompanyId = d return $ [ AdminProblemSupervisorLeftCompany subid oldCompanyId oldSuperReroute | (Entity{entityVal=UserSupervisor{userSupervisorUser=subid}}, E.Value True) <- supervisees ] -- supervisors of uid - let superDeftFltr = (UserSupervisorUser ==. uid) : (UserSupervisorReason ~=. superReasonComDef) - oldSubFltr = (UserSupervisorCompany ~=. oldCompanyId) <> superDeftFltr + let superDeftFltr = (UserSupervisorUser ==. uid) : (UserSupervisorReason ~=. superReasonComDef) -- default or no reason + oldSubFltr = (UserSupervisorCompany ~=. oldCompanyId) <> superDeftFltr -- old company or no company oldAPs <- if keepOldCompanySupervs then updateWhereCount oldSubFltr [UserSupervisorReason =. Nothing] else deleteWhereCount oldSubFltr - void $ addDefaultSupervisors Nothing newCompanyId $ singleton uid + nrDefSups <- addDefaultSupervisors' newCompanyId $ singleton uid -- CHECK HERE WITH LINES ABOVE newAPs <- count $ (UserSupervisorCompany ==. Just newCompanyId) : superDeftFltr let isNoLongerSupervised = not keepOldCompanySupervs && oldAPs > 0 && newAPs <= 0 problems = bcons oldSuper (AdminProblemSupervisorNewCompany uid oldCompanyId newCompanyId oldSuperReroute) $ bcons isNoLongerSupervised (AdminProblemNewlyUnsupervised uid (Just oldCompanyId) newCompanyId) newlyUnsupervised + delupd = bool "deleted" "updated" keepOldCompanySupervs :: Text + $logInfoS "Supervision" [st|switchAvsUserCompany for #{tshow uid} from #{unCompanyKey oldCompanyId} to #{unCompanyKey newCompanyId}. #{oldAPs} old APs #{delupd}. #{nrDefSups} default company supervisors upserted. #{newAPs} new company supervisors counted now.|] return (usrUpdate ,problems) defaultSupervisorReasonFilter :: [Filter UserSupervisor] diff --git a/src/Handler/Utils/Users.hs b/src/Handler/Utils/Users.hs index 0c0f3037c..80ad8f6ac 100644 --- a/src/Handler/Utils/Users.hs +++ b/src/Handler/Utils/Users.hs @@ -78,10 +78,9 @@ abbrvName User{userDisplayName, userFirstName, userSurname} = assemble = Text.intercalate "." --- Note: Entity can be recovered, since CompanyShort is also the key --- getUserPrimaryCompany :: UserId -> DBRead (Maybe UserCompany) --- getUserPrimaryCompany :: (MonadIO m, PersistQueryRead backend, BaseBackend backend ~ SqlBackend) => --- UserId -> ReaderT backend m (Maybe UserCompany) +-- | Retrieve primary company association for user. +-- Warning: if there are multiple associations witht the same priority, one with rerouting and supervision are preferred, them alphabetically +-- Note that Entity Company can be retrieved, since CompanyShorthand is the DB key. getUserPrimaryCompany :: UserId -> DBRead' (Maybe UserCompany) getUserPrimaryCompany uid = entityVal <<$>> selectFirst [UserCompanyUser ==. uid]