fix(avs): avs firm update no longer may update wrong company

Note: noticed while working on #225
This commit is contained in:
Steffen Jost 2024-10-09 11:47:46 +02:00
parent 3960931bb5
commit be7fc2e540
2 changed files with 13 additions and 10 deletions

View File

@ -585,16 +585,18 @@ 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)
| newAvsFirmInfo == oldAvsFirmInfo = maybeM (upsertAvsCompany newAvsFirmInfo Nothing) pure $ getAvsCompany newAvsFirmInfo -- firmInfo unchanged, shortcircuit
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 mbFirmEnt} new #{tshow newAvsFirmInfo}|] $logInfoS "AVS" [st|upsertAvsCompany: old #{tshow mbOldAvsFirmInfo} new #{tshow newAvsFirmInfo} ent-new #{tshow mbFirmEnt}|]
case (mbFirmEnt, mbOldAvsFirmInfo) of case mbFirmEnt of
(Nothing, _) -> do -- insert new company, neither AvsId nor Shorthand exist in DB Nothing -> do -- insert new company, neither AvsId nor Shorthand exist in DB
afn <- if 0 < newAvsFirmInfo ^. _avsFirmFirmNo afn <- if 0 < newAvsFirmInfo ^. _avsFirmFirmNo
then return $ newAvsFirmInfo ^. _avsFirmFirmNo then return $ newAvsFirmInfo ^. _avsFirmFirmNo
else maybe (-1) (pred . companyAvsId . entityVal) <$> selectMaybe [CompanyAvsId <. 0] [Asc CompanyAvsId] else maybe (-1) (pred . companyAvsId . entityVal) <$> selectMaybe [CompanyAvsId <. 0] [Asc CompanyAvsId]
let upd = flip updateRecord newAvsFirmInfo let upd = flip updateRecord newAvsFirmInfo
dmy = Company -- mostly dummy, values are actually prodcued through firmInfo2company below for consistency dmy = Company -- mostly dummy, values are actually produced through firmInfo2company below for consistency
{ companyName = newAvsFirmInfo ^. _avsFirmFirm . from _CI { companyName = newAvsFirmInfo ^. _avsFirmFirm . from _CI
, companyShorthand = newAvsFirmInfo ^. _avsFirmAbbreviation . from _CI , companyShorthand = newAvsFirmInfo ^. _avsFirmAbbreviation . from _CI
, companyAvsId = afn , companyAvsId = afn
@ -606,11 +608,12 @@ upsertAvsCompany newAvsFirmInfo mbOldAvsFirmInfo = do
$logInfoS "AVS" $ "Insert new company: " <> tshow cmp $logInfoS "AVS" $ "Insert new company: " <> tshow cmp
newCmp <- insertEntity cmp newCmp <- insertEntity cmp
reportAdminProblem $ AdminProblemNewCompany $ entityKey newCmp reportAdminProblem $ AdminProblemNewCompany $ entityKey newCmp
$logInfoS "AVS" "Insert new company completed."
return newCmp return newCmp
(Just Entity{entityKey=firmid, entityVal=firm}, oldAvsFirmInfo) -> do -- possibly update existing company, if isJust oldAvsFirmInfo and changed occurred (Just Entity{entityKey=firmid, entityVal=firm}) -> do -- possibly update existing company, if isJust oldAvsFirmInfo and identical AvsFirmNo and changes occurred
let cmp_ups = mapMaybe (mkUpdate' firm newAvsFirmInfo oldAvsFirmInfo) firmInfo2company let oldHasSameFirmNo = Just (newAvsFirmInfo ^. _avsFirmFirmNo) == (mbOldAvsFirmInfo ^? _Just . _avsFirmFirmNo)
oldAvsFirmInfo = guardOnM oldHasSameFirmNo mbOldAvsFirmInfo
cmp_ups = mapMaybe (mkUpdate' firm newAvsFirmInfo oldAvsFirmInfo) firmInfo2company
key_ups = mkUpdate' firm newAvsFirmInfo oldAvsFirmInfo firmInfo2key key_ups = mkUpdate' firm newAvsFirmInfo oldAvsFirmInfo firmInfo2key
uniq_ups <- mkUpdateCheckUnique' firm newAvsFirmInfo oldAvsFirmInfo firmInfo2companyNo uniq_ups <- mkUpdateCheckUnique' firm newAvsFirmInfo oldAvsFirmInfo firmInfo2companyNo
$logInfoS "AVS" [st|Update company #{companyShorthand firm}: #{tshow (length cmp_ups)}, #{tshow (length key_ups)}, #{tshow (length uniq_ups)} for #{tshow oldAvsFirmInfo}|] $logInfoS "AVS" [st|Update company #{companyShorthand firm}: #{tshow (length cmp_ups)}, #{tshow (length key_ups)}, #{tshow (length uniq_ups)} for #{tshow oldAvsFirmInfo}|]
@ -629,7 +632,7 @@ upsertAvsCompany newAvsFirmInfo mbOldAvsFirmInfo = do
| otherwise -> $logInfoS "AVS" $ "Update company shorthand failed for " <> ciOriginal cmp_key <> " and " <> ciOriginal alt_key | otherwise -> $logInfoS "AVS" $ "Update company shorthand failed for " <> ciOriginal cmp_key <> " and " <> ciOriginal alt_key
maybeM (return res_cmp) return $ getBy uniq_cmp maybeM (return res_cmp) return $ getBy uniq_cmp
_otherwise -> return res_cmp _otherwise -> return res_cmp
$logInfoS "AVS" "Update company completed." $logInfoS "AVS" [st|Update company #{companyShorthand firm} completed.|]
return res_cmp2 return res_cmp2
where where
firmInfo2key = firmInfo2key =

View File

@ -122,11 +122,11 @@ dispatchJobSynchroniseAvsQueue = JobHandlerException $ do
-- E.truncateTable $ AvsSync (error "truncateTable: AvsSyncUser not needed") now Nothing -- E.truncateTable $ AvsSync (error "truncateTable: AvsSyncUser not needed") now Nothing
-- return jobs -- return jobs
let (unlinked, linked) = foldl' discernJob mempty jobs let (unlinked, linked) = foldl' discernJob mempty jobs
$logInfoS "SynchronisAvs" [st|AVS synch performing for #{length linked} AVS linked users and #{length unlinked} unlinked users|] $logInfoS "SynchronisAvs" [st|AVS synch start for #{length linked} AVS linked users and #{length unlinked} unlinked users|]
void $ updateAvsUserByIds linked void $ updateAvsUserByIds linked
void $ linktoAvsUserByUIDs unlinked void $ linktoAvsUserByUIDs unlinked
runDB $ deleteWhere [AvsSyncUser <-. (E.unValue . fst3 <$> jobs)] runDB $ deleteWhere [AvsSyncUser <-. (E.unValue . fst3 <$> jobs)]
$logInfoS "SynchronisAvs" [st|AVS synch performed for #{length linked} AVS linked users and #{length unlinked} unlinked users|] $logInfoS "SynchronisAvs" [st|AVS synch end for #{length linked} AVS linked users and #{length unlinked} unlinked users|]
-- we do not reschedule failed synchs here in order to avoid a loop -- we do not reschedule failed synchs here in order to avoid a loop
where where
discernJob accs ( _ , E.Value (Just api), E.Value True ) = accs & over _2 (Set.insert api) discernJob accs ( _ , E.Value (Just api), E.Value True ) = accs & over _2 (Set.insert api)