diff --git a/src/Handler/Utils/Avs.hs b/src/Handler/Utils/Avs.hs index 261dea6b9..400292445 100644 --- a/src/Handler/Utils/Avs.hs +++ b/src/Handler/Utils/Avs.hs @@ -585,16 +585,18 @@ 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 mbOldAvsFirmInfo = do mbFirmEnt <- getAvsCompany newAvsFirmInfo -- primarily by AvsId, then Shorthand, then name - $logInfoS "AVS" [st|upsertAvsCompany: old #{tshow mbFirmEnt} new #{tshow newAvsFirmInfo}|] - case (mbFirmEnt, mbOldAvsFirmInfo) of - (Nothing, _) -> do -- insert new company, neither AvsId nor Shorthand exist in DB + $logInfoS "AVS" [st|upsertAvsCompany: old #{tshow mbOldAvsFirmInfo} new #{tshow newAvsFirmInfo} ent-new #{tshow mbFirmEnt}|] + case mbFirmEnt of + Nothing -> do -- insert new company, neither AvsId nor Shorthand exist in DB afn <- if 0 < newAvsFirmInfo ^. _avsFirmFirmNo then return $ newAvsFirmInfo ^. _avsFirmFirmNo else maybe (-1) (pred . companyAvsId . entityVal) <$> selectMaybe [CompanyAvsId <. 0] [Asc CompanyAvsId] 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 , companyShorthand = newAvsFirmInfo ^. _avsFirmAbbreviation . from _CI , companyAvsId = afn @@ -606,11 +608,12 @@ upsertAvsCompany newAvsFirmInfo mbOldAvsFirmInfo = do $logInfoS "AVS" $ "Insert new company: " <> tshow cmp newCmp <- insertEntity cmp reportAdminProblem $ AdminProblemNewCompany $ entityKey newCmp - $logInfoS "AVS" "Insert new company completed." return newCmp - (Just Entity{entityKey=firmid, entityVal=firm}, oldAvsFirmInfo) -> do -- possibly update existing company, if isJust oldAvsFirmInfo and changed occurred - let cmp_ups = mapMaybe (mkUpdate' firm newAvsFirmInfo oldAvsFirmInfo) firmInfo2company + (Just Entity{entityKey=firmid, entityVal=firm}) -> do -- possibly update existing company, if isJust oldAvsFirmInfo and identical AvsFirmNo and changes occurred + 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 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}|] @@ -629,7 +632,7 @@ upsertAvsCompany newAvsFirmInfo mbOldAvsFirmInfo = do | otherwise -> $logInfoS "AVS" $ "Update company shorthand failed for " <> ciOriginal cmp_key <> " and " <> ciOriginal alt_key maybeM (return res_cmp) return $ getBy uniq_cmp _otherwise -> return res_cmp - $logInfoS "AVS" "Update company completed." + $logInfoS "AVS" [st|Update company #{companyShorthand firm} completed.|] return res_cmp2 where firmInfo2key = diff --git a/src/Jobs/Handler/SynchroniseAvs.hs b/src/Jobs/Handler/SynchroniseAvs.hs index 0e290328d..67f9a9399 100644 --- a/src/Jobs/Handler/SynchroniseAvs.hs +++ b/src/Jobs/Handler/SynchroniseAvs.hs @@ -122,11 +122,11 @@ dispatchJobSynchroniseAvsQueue = JobHandlerException $ do -- E.truncateTable $ AvsSync (error "truncateTable: AvsSyncUser not needed") now Nothing -- return 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 $ linktoAvsUserByUIDs unlinked 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 where discernJob accs ( _ , E.Value (Just api), E.Value True ) = accs & over _2 (Set.insert api)