fraport/fradrive-old
fraport/fradrive-old
Archived
3
1
Fork 0
Code Issues 65 Pull Requests 5 Actions Packages Projects Releases 197 Wiki Activity

fix(avs): fix #225 by skipping firm updates entirely if AVS FirmInfo is unchanged for previously seen values for AVS User to be updated

Browse Source
This commit is contained in:
Steffen Jost 2024-10-09 12:21:31 +02:00
parent e554048f5a
commit 3b0029ba04
1 changed files with 70 additions and 67 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -329,6 +329,8 @@ updateAvsUserByADC newAvsDataContact@(AvsDataContact apid newAvsPersonInfo newAv
let usrId = userAvsUser usravs let usrId = userAvsUser usravs
usr <- MaybeT $ get usrId usr <- MaybeT $ get usrId
lift $ do -- maybeT no longer needed from here onwards lift $ do -- maybeT no longer needed from here onwards
uuid :: CryptoUUIDUser <- encrypt usrId
$logInfoS "AVS" [st|updateAvsUserByADC: #{tshow uuid}|]
let oldAvsPersonInfo = userAvsLastPersonInfo usravs -- Nothing is ok here let oldAvsPersonInfo = userAvsLastPersonInfo usravs -- Nothing is ok here
oldAvsFirmInfo = userAvsLastFirmInfo usravs -- Nothing is ok here oldAvsFirmInfo = userAvsLastFirmInfo usravs -- Nothing is ok here
oldAvsCardNo = userAvsLastCardNo usravs & fmap Just oldAvsCardNo = userAvsLastCardNo usravs & fmap Just
@ -380,72 +382,73 @@ updateAvsUserByADC newAvsDataContact@(AvsDataContact apid newAvsPersonInfo newAv
, UserAvsLastCardNo =. newAvsCardNo , UserAvsLastCardNo =. newAvsCardNo
] ]
-- update company association & supervision usr_up2 <- guardMonoidM (oldAvsFirmInfo /= Just newAvsFirmInfo) $ do
newCompanyEnt@Entity{entityKey=newCompanyId} <- upsertAvsCompany newAvsFirmInfo oldAvsFirmInfo -- update company association & supervision
oldCompanyEnt <- getAvsCompany `traverseJoin` oldAvsFirmInfo newCompanyEnt@Entity{entityKey=newCompanyId} <- upsertAvsCompany newAvsFirmInfo oldAvsFirmInfo
primaryCompanyId <- userCompanyCompany <<$>> getUserPrimaryCompany usrId upsertCompanySuperior newCompanyEnt newAvsFirmInfo oldAvsFirmInfo usrId -- ensure firmInfo superior is supervisor for this user
let oldCompanyId = entityKey <$> oldCompanyEnt oldCompanyEnt <- getAvsCompany `traverseJoin` oldAvsFirmInfo
-- oldCompanyMb = entityVal <$> oldCompanyEnt primaryCompanyId <- userCompanyCompany <<$>> getUserPrimaryCompany usrId
-- pst_up = if let oldCompanyId = entityKey <$> oldCompanyEnt
-- -- | isNothing oldCompanyMb || oldCompanyId == primaryCompanyId -- refactor could replace next 4 lines -- oldCompanyMb = entityVal <$> oldCompanyEnt
-- -- -> mkUpdate' usr newCompany oldCompanyMb $ CheckUpdate UserPrefersPostal _companyPrefersPostal -- always update if company association is fresh (case should not occur in practice though) -- pst_up = if
-- | isNothing oldCompanyMb -- -- | isNothing oldCompanyMb || oldCompanyId == primaryCompanyId -- refactor could replace next 4 lines
-- -> mkUpdateDirect usr newCompany $ CheckUpdate UserPrefersPostal _companyPrefersPostal -- always update if company association is fresh (case should not occur in practice though) -- -- -> mkUpdate' usr newCompany oldCompanyMb $ CheckUpdate UserPrefersPostal _companyPrefersPostal -- always update if company association is fresh (case should not occur in practice though)
-- | oldCompanyId == primaryCompanyId -- && isJust oldCompanyId -- is ensured by previous line -- | isNothing oldCompanyMb
-- -> mkUpdate usr newCompany oldCompanyMb $ CheckUpdate UserPrefersPostal _companyPrefersPostal -- possibly change postal preference -- -> mkUpdateDirect usr newCompany $ CheckUpdate UserPrefersPostal _companyPrefersPostal -- always update if company association is fresh (case should not occur in practice though)
-- | otherwise -- | oldCompanyId == primaryCompanyId -- && isJust oldCompanyId -- is ensured by previous line
-- -> Nothing -- -> mkUpdate usr newCompany oldCompanyMb $ CheckUpdate UserPrefersPostal _companyPrefersPostal -- possibly change postal preference
superReasonComDef = tshow SupervisorReasonCompanyDefault -- | otherwise
newUserComp = UserCompany usrId newCompanyId False False 1 True Nothing -- default value for new company insertion, if no update can be done -- -> Nothing
superReasonComDef = tshow SupervisorReasonCompanyDefault
newUserComp = UserCompany usrId newCompanyId False False 1 True Nothing -- default value for new company insertion, if no update can be done
usr_up2 <- case oldAvsFirmInfo of case oldAvsFirmInfo of
_ | Just newCompanyId == oldCompanyId -- company unchanged entirely _ | Just newCompanyId == oldCompanyId -- company unchanged entirely
-> return mempty -- => do nothing -> return mempty -- => do nothing
(Just oafi) | isJust (view _avsFirmPostAddressSimple oafi) (Just oafi) | isJust (view _avsFirmPostAddressSimple oafi)
&& ((==) `on` view _avsFirmPostAddressSimple) oafi newAvsFirmInfo -- non-empty company address unchanged OR && ((==) `on` view _avsFirmPostAddressSimple) oafi newAvsFirmInfo -- non-empty company address unchanged OR
|| isJust (view _avsFirmPrimaryEmail oafi) || isJust (view _avsFirmPrimaryEmail oafi)
&& ((==) `on` view _avsFirmPrimaryEmail) oafi newAvsFirmInfo -- non-empty company primary email unchanged && ((==) `on` view _avsFirmPrimaryEmail) oafi newAvsFirmInfo -- non-empty company primary email unchanged
-> do -- => just update user company association, keeping supervision privileges -> do -- => just update user company association, keeping supervision privileges
case oldCompanyId of case oldCompanyId of
Nothing -> void $ insertUnique newUserComp -- it's ok if this already exists Nothing -> void $ insertUnique newUserComp -- it's ok if this already exists
Just ocid -> do Just ocid -> do
void $ upsertBySafe (UniqueUserCompany usrId ocid) newUserComp (_userCompanyCompany .~ newCompanyId) -- keep default supervisor settings void $ upsertBySafe (UniqueUserCompany usrId ocid) newUserComp (_userCompanyCompany .~ newCompanyId) -- keep default supervisor settings
void $ updateWhere [ UserSupervisorSupervisor ==. usrId -- update company-related supervisions void $ updateWhere [ UserSupervisorSupervisor ==. usrId -- update company-related supervisions
, UserSupervisorCompany ==. Just ocid -- to new company, regardless of , UserSupervisorCompany ==. Just ocid -- to new company, regardless of
, UserSupervisorReason ==. Just superReasonComDef] -- user , UserSupervisorReason ==. Just superReasonComDef] -- user
[ UserSupervisorCompany =. Just newCompanyId] [ UserSupervisorCompany =. Just newCompanyId]
return mempty return mempty
_ | Just newCompanyId == primaryCompanyId -- old primaryCompany is now also AVS-company _ | Just newCompanyId == primaryCompanyId -- old primaryCompany is now also AVS-company
-> do -> do
whenIsJust oldCompanyId $ \oldCid -> do whenIsJust oldCompanyId $ \oldCid -> do
deleteBy $ UniqueUserCompany usrId oldCid deleteBy $ UniqueUserCompany usrId oldCid
deleteWhere $ (UserSupervisorUser ==. usrId):(UserSupervisorCompany ==. oldCompanyId):(UserSupervisorReason ~=. superReasonComDef) deleteWhere $ (UserSupervisorUser ==. usrId):(UserSupervisorCompany ==. oldCompanyId):(UserSupervisorReason ~=. superReasonComDef)
return mempty return mempty
_ -- company changed completely _ -- company changed completely
-> do -> do
(pst_up, problems) <- switchAvsUserCompany False False usrId newCompanyId (pst_up, problems) <- switchAvsUserCompany False False usrId newCompanyId
mapM_ reportAdminProblem problems mapM_ reportAdminProblem problems
-- Following line does not type, hence additional parameter needed -- 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) -- 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)
return pst_up return pst_up
-- SPECIALISED CODE, PROBABLY DEPRECATED -- SPECIALISED CODE, PROBABLY DEPRECATED
-- switch user company, keeping old priority -- switch user company, keeping old priority
-- (getBy . UniqueUserCompany usrId) `traverseJoin` oldCompanyId >>= \case -- (getBy . UniqueUserCompany usrId) `traverseJoin` oldCompanyId >>= \case
-- Nothing -> -- Nothing ->
-- void $ insertUnique newUserComp -- void $ insertUnique newUserComp
-- Just Entity{entityKey=ucidOld, entityVal=UserCompany{userCompanyCompany, userCompanySupervisor, userCompanySupervisorReroute, userCompanyPriority}} -> do -- Just Entity{entityKey=ucidOld, entityVal=UserCompany{userCompanyCompany, userCompanySupervisor, userCompanySupervisorReroute, userCompanyPriority}} -> do
-- when userCompanySupervisor $ reportAdminProblem $ AdminProblemSupervisorNewCompany usrId userCompanyCompany newCompanyId userCompanySupervisorReroute -- when userCompanySupervisor $ reportAdminProblem $ AdminProblemSupervisorNewCompany usrId userCompanyCompany newCompanyId userCompanySupervisorReroute
-- delete ucidOld -- delete ucidOld
-- void $ insertUnique newUserComp{userCompanyPriority} -- keep priority, if insert succeeds -- void $ insertUnique newUserComp{userCompanyPriority} -- keep priority, if insert succeeds
-- -- adjust supervison -- -- adjust supervison
-- let oldCompDefSuperFltr = mconcat [UserSupervisorCompany ~~. oldCompanyId, UserSupervisorReason ~=. superReasonComDef] -- let oldCompDefSuperFltr = mconcat [UserSupervisorCompany ~~. oldCompanyId, UserSupervisorReason ~=. superReasonComDef]
-- deleteWhere $ (UserSupervisorSupervisor ==. usrId) : oldCompDefSuperFltr -- deleteWhere $ (UserSupervisorSupervisor ==. usrId) : oldCompDefSuperFltr
-- oldAPs <- deleteWhereCount $ (UserSupervisorUser ==. usrId) : oldCompDefSuperFltr -- oldAPs <- deleteWhereCount $ (UserSupervisorUser ==. usrId) : oldCompDefSuperFltr
-- addDefaultSupervisors' newCompanyId $ singleton usrId -- addDefaultSupervisors' newCompanyId $ singleton usrId
-- 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
@ -585,8 +588,8 @@ getAvsCompany afi =
-- | insert a company from AVS firm info or update an existing one based on previous values -- | insert a company from AVS firm info or update an existing one based on previous values
upsertAvsCompany :: AvsFirmInfo -> Maybe AvsFirmInfo -> DB (Entity Company) upsertAvsCompany :: AvsFirmInfo -> Maybe AvsFirmInfo -> DB (Entity Company)
upsertAvsCompany newAvsFirmInfo (Just oldAvsFirmInfo) -- upsertAvsCompany newAvsFirmInfo (Just oldAvsFirmInfo)
| newAvsFirmInfo == oldAvsFirmInfo = maybeM (upsertAvsCompany newAvsFirmInfo Nothing) pure $ getAvsCompany newAvsFirmInfo -- firmInfo unchanged, shortcircuit -- | newAvsFirmInfo == oldAvsFirmInfo = maybeM (upsertAvsCompany newAvsFirmInfo Nothing) pure $ getAvsCompany newAvsFirmInfo -- firmInfo unchanged, shortcircuit; SHORTCIRCUIT no longer needed, checked at call-site due to result not being wrapped in Maybe
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 mbOldAvsFirmInfo} new #{tshow newAvsFirmInfo} ent-new #{tshow mbFirmEnt}|] $logInfoS "AVS" [st|upsertAvsCompany: old #{tshow mbOldAvsFirmInfo} new #{tshow newAvsFirmInfo} ent-new #{tshow mbFirmEnt}|]