fix(avs): fix #225 by skipping firm updates entirely if AVS FirmInfo is unchanged for previously seen values for AVS User to be updated
This commit is contained in:
parent
e554048f5a
commit
3b0029ba04
@ -329,6 +329,8 @@ updateAvsUserByADC newAvsDataContact@(AvsDataContact apid newAvsPersonInfo newAv
|
||||
let usrId = userAvsUser usravs
|
||||
usr <- MaybeT $ get usrId
|
||||
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
|
||||
oldAvsFirmInfo = userAvsLastFirmInfo usravs -- Nothing is ok here
|
||||
oldAvsCardNo = userAvsLastCardNo usravs & fmap Just
|
||||
@ -380,72 +382,73 @@ updateAvsUserByADC newAvsDataContact@(AvsDataContact apid newAvsPersonInfo newAv
|
||||
, UserAvsLastCardNo =. newAvsCardNo
|
||||
]
|
||||
|
||||
-- update company association & supervision
|
||||
newCompanyEnt@Entity{entityKey=newCompanyId} <- upsertAvsCompany newAvsFirmInfo oldAvsFirmInfo
|
||||
oldCompanyEnt <- getAvsCompany `traverseJoin` oldAvsFirmInfo
|
||||
primaryCompanyId <- userCompanyCompany <<$>> getUserPrimaryCompany usrId
|
||||
let oldCompanyId = entityKey <$> oldCompanyEnt
|
||||
-- oldCompanyMb = entityVal <$> oldCompanyEnt
|
||||
-- pst_up = if
|
||||
-- -- | isNothing oldCompanyMb || oldCompanyId == primaryCompanyId -- refactor could replace next 4 lines
|
||||
-- -- -> mkUpdate' usr newCompany oldCompanyMb $ CheckUpdate UserPrefersPostal _companyPrefersPostal -- always update if company association is fresh (case should not occur in practice though)
|
||||
-- | isNothing oldCompanyMb
|
||||
-- -> mkUpdateDirect usr newCompany $ 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
|
||||
-- -> mkUpdate usr newCompany oldCompanyMb $ CheckUpdate UserPrefersPostal _companyPrefersPostal -- possibly change postal preference
|
||||
-- | otherwise
|
||||
-- -> 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 <- guardMonoidM (oldAvsFirmInfo /= Just newAvsFirmInfo) $ do
|
||||
-- update company association & supervision
|
||||
newCompanyEnt@Entity{entityKey=newCompanyId} <- upsertAvsCompany newAvsFirmInfo oldAvsFirmInfo
|
||||
upsertCompanySuperior newCompanyEnt newAvsFirmInfo oldAvsFirmInfo usrId -- ensure firmInfo superior is supervisor for this user
|
||||
oldCompanyEnt <- getAvsCompany `traverseJoin` oldAvsFirmInfo
|
||||
primaryCompanyId <- userCompanyCompany <<$>> getUserPrimaryCompany usrId
|
||||
let oldCompanyId = entityKey <$> oldCompanyEnt
|
||||
-- oldCompanyMb = entityVal <$> oldCompanyEnt
|
||||
-- pst_up = if
|
||||
-- -- | isNothing oldCompanyMb || oldCompanyId == primaryCompanyId -- refactor could replace next 4 lines
|
||||
-- -- -> mkUpdate' usr newCompany oldCompanyMb $ CheckUpdate UserPrefersPostal _companyPrefersPostal -- always update if company association is fresh (case should not occur in practice though)
|
||||
-- | isNothing oldCompanyMb
|
||||
-- -> mkUpdateDirect usr newCompany $ 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
|
||||
-- -> mkUpdate usr newCompany oldCompanyMb $ CheckUpdate UserPrefersPostal _companyPrefersPostal -- possibly change postal preference
|
||||
-- | otherwise
|
||||
-- -> 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
|
||||
_ | Just newCompanyId == oldCompanyId -- company unchanged entirely
|
||||
-> return mempty -- => do nothing
|
||||
(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
|
||||
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]
|
||||
return mempty
|
||||
_ | Just newCompanyId == primaryCompanyId -- old primaryCompany is now also AVS-company
|
||||
-> do
|
||||
whenIsJust oldCompanyId $ \oldCid -> do
|
||||
deleteBy $ UniqueUserCompany usrId oldCid
|
||||
deleteWhere $ (UserSupervisorUser ==. usrId):(UserSupervisorCompany ==. oldCompanyId):(UserSupervisorReason ~=. superReasonComDef)
|
||||
return mempty
|
||||
_ -- company changed completely
|
||||
-> do
|
||||
(pst_up, problems) <- switchAvsUserCompany False False usrId newCompanyId
|
||||
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)
|
||||
return pst_up
|
||||
-- SPECIALISED CODE, PROBABLY DEPRECATED
|
||||
-- switch user company, keeping old priority
|
||||
-- (getBy . UniqueUserCompany usrId) `traverseJoin` oldCompanyId >>= \case
|
||||
-- Nothing ->
|
||||
-- void $ insertUnique newUserComp
|
||||
-- Just Entity{entityKey=ucidOld, entityVal=UserCompany{userCompanyCompany, userCompanySupervisor, userCompanySupervisorReroute, userCompanyPriority}} -> do
|
||||
-- when userCompanySupervisor $ reportAdminProblem $ AdminProblemSupervisorNewCompany usrId userCompanyCompany newCompanyId userCompanySupervisorReroute
|
||||
-- delete ucidOld
|
||||
-- void $ insertUnique newUserComp{userCompanyPriority} -- keep priority, if insert succeeds
|
||||
-- -- adjust supervison
|
||||
-- let oldCompDefSuperFltr = mconcat [UserSupervisorCompany ~~. oldCompanyId, UserSupervisorReason ~=. superReasonComDef]
|
||||
-- deleteWhere $ (UserSupervisorSupervisor ==. usrId) : oldCompDefSuperFltr
|
||||
-- oldAPs <- deleteWhereCount $ (UserSupervisorUser ==. usrId) : oldCompDefSuperFltr
|
||||
-- addDefaultSupervisors' newCompanyId $ singleton usrId
|
||||
-- newAPs <- count $ (UserSupervisorUser ==. usrId) : (UserSupervisorCompany ==. Just newCompanyId) : (UserSupervisorReason ~=. superReasonComDef)
|
||||
-- when (oldAPs > 0 && newAPs <= 0) $ reportAdminProblem $ AdminProblemNewlyUnsupervised usrId oldCompanyId newCompanyId
|
||||
-- return pst_up
|
||||
upsertCompanySuperior newCompanyEnt newAvsFirmInfo oldAvsFirmInfo usrId -- ensure firmInfo superior is supervisor for this user
|
||||
case oldAvsFirmInfo of
|
||||
_ | Just newCompanyId == oldCompanyId -- company unchanged entirely
|
||||
-> return mempty -- => do nothing
|
||||
(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
|
||||
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]
|
||||
return mempty
|
||||
_ | Just newCompanyId == primaryCompanyId -- old primaryCompany is now also AVS-company
|
||||
-> do
|
||||
whenIsJust oldCompanyId $ \oldCid -> do
|
||||
deleteBy $ UniqueUserCompany usrId oldCid
|
||||
deleteWhere $ (UserSupervisorUser ==. usrId):(UserSupervisorCompany ==. oldCompanyId):(UserSupervisorReason ~=. superReasonComDef)
|
||||
return mempty
|
||||
_ -- company changed completely
|
||||
-> do
|
||||
(pst_up, problems) <- switchAvsUserCompany False False usrId newCompanyId
|
||||
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)
|
||||
return pst_up
|
||||
-- SPECIALISED CODE, PROBABLY DEPRECATED
|
||||
-- switch user company, keeping old priority
|
||||
-- (getBy . UniqueUserCompany usrId) `traverseJoin` oldCompanyId >>= \case
|
||||
-- Nothing ->
|
||||
-- void $ insertUnique newUserComp
|
||||
-- Just Entity{entityKey=ucidOld, entityVal=UserCompany{userCompanyCompany, userCompanySupervisor, userCompanySupervisorReroute, userCompanyPriority}} -> do
|
||||
-- when userCompanySupervisor $ reportAdminProblem $ AdminProblemSupervisorNewCompany usrId userCompanyCompany newCompanyId userCompanySupervisorReroute
|
||||
-- delete ucidOld
|
||||
-- void $ insertUnique newUserComp{userCompanyPriority} -- keep priority, if insert succeeds
|
||||
-- -- adjust supervison
|
||||
-- let oldCompDefSuperFltr = mconcat [UserSupervisorCompany ~~. oldCompanyId, UserSupervisorReason ~=. superReasonComDef]
|
||||
-- deleteWhere $ (UserSupervisorSupervisor ==. usrId) : oldCompDefSuperFltr
|
||||
-- oldAPs <- deleteWhereCount $ (UserSupervisorUser ==. usrId) : oldCompDefSuperFltr
|
||||
-- addDefaultSupervisors' newCompanyId $ singleton usrId
|
||||
-- newAPs <- count $ (UserSupervisorUser ==. usrId) : (UserSupervisorCompany ==. Just newCompanyId) : (UserSupervisorReason ~=. superReasonComDef)
|
||||
-- when (oldAPs > 0 && newAPs <= 0) $ reportAdminProblem $ AdminProblemNewlyUnsupervised usrId oldCompanyId newCompanyId
|
||||
-- return pst_up
|
||||
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 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
|
||||
upsertAvsCompany :: AvsFirmInfo -> Maybe AvsFirmInfo -> DB (Entity Company)
|
||||
upsertAvsCompany newAvsFirmInfo (Just oldAvsFirmInfo)
|
||||
| newAvsFirmInfo == oldAvsFirmInfo = maybeM (upsertAvsCompany newAvsFirmInfo Nothing) pure $ getAvsCompany newAvsFirmInfo -- firmInfo unchanged, shortcircuit
|
||||
-- upsertAvsCompany newAvsFirmInfo (Just oldAvsFirmInfo)
|
||||
-- | 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
|
||||
mbFirmEnt <- getAvsCompany newAvsFirmInfo -- primarily by AvsId, then Shorthand, then name
|
||||
$logInfoS "AVS" [st|upsertAvsCompany: old #{tshow mbOldAvsFirmInfo} new #{tshow newAvsFirmInfo} ent-new #{tshow mbFirmEnt}|]
|
||||
|
||||
Reference in New Issue
Block a user