From 9451d90a9e00d08a2a7d169c4674d99ff1018ee9 Mon Sep 17 00:00:00 2001 From: Steffen Date: Thu, 23 May 2024 17:08:30 +0200 Subject: [PATCH] fix(avs): company update checks uniques and ignores those updates if necessary --- src/Handler/Utils/Avs.hs | 36 ++++++++++++++++++++---------------- src/Utils/DB.hs | 26 +++++++++++++++++++++++++- 2 files changed, 45 insertions(+), 17 deletions(-) diff --git a/src/Handler/Utils/Avs.hs b/src/Handler/Utils/Avs.hs index 9f4951f49..becae74c6 100644 --- a/src/Handler/Utils/Avs.hs +++ b/src/Handler/Utils/Avs.hs @@ -565,16 +565,16 @@ getAvsCompany afi = in firstJustM $ bcons (compAvsId > 0) ( getBy $ UniqueCompanyAvsId compAvsId ) - [ getEntity $ CompanyKey compShorthand - , getBy $ UniqueCompanyName compName + [ getBy $ UniqueCompanyName compName + , getEntity $ CompanyKey compShorthand ] -- | 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 mbOldAvsFirmInfo = do - mbFirmEnt <- getAvsCompany newAvsFirmInfo + mbFirmEnt <- getAvsCompany newAvsFirmInfo -- primarily by AvsId, then Shorthand, then name case (mbFirmEnt, mbOldAvsFirmInfo) of - (Nothing, _) -> do -- insert new company + (Nothing, _) -> do -- insert new company, neither AvsId, Shorthand or Name are known to exist let upd = flip updateRecord newAvsFirmInfo dmy = Company -- mostly dummy, values are actually prodcued through firmInfo2company below for consistency { companyName = newAvsFirmInfo ^. _avsFirmFirm . from _CI @@ -583,32 +583,36 @@ upsertAvsCompany newAvsFirmInfo mbOldAvsFirmInfo = do , companyPrefersPostal = True , companyPostAddress = newAvsFirmInfo ^. _avsFirmPostAddress , companyEmail = newAvsFirmInfo ^? _avsFirmPrimaryEmail . _Just . from _CI - } - newCmp <- insertEntity $ foldl' upd dmy $ firmInfo2key : firmInfo2company + } + newCmp <- insertEntity $ foldl' upd dmy $ firmInfo2key : firmInfo2companyUniques <> firmInfo2company reportAdminProblem $ AdminProblemNewCompany $ entityKey newCmp 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 - key_ups = mkUpdate' firm newAvsFirmInfo oldAvsFirmInfo firmInfo2key - res_cmp <- updateGetEntity firmid cmp_ups + let cmp_ups = mapMaybe (mkUpdate' firm newAvsFirmInfo oldAvsFirmInfo) firmInfo2company + key_ups = mkUpdate' firm newAvsFirmInfo oldAvsFirmInfo firmInfo2key + uniq_ups <- maybeMapM (mkUpdateCheckUnique' firm newAvsFirmInfo oldAvsFirmInfo) firmInfo2companyUniques + res_cmp <- updateGetEntity firmid $ cmp_ups <> uniq_ups case key_ups of Nothing -> return res_cmp Just key_up -> do - let uniq_cmp = UniqueCompanyAvsId $ res_cmp ^. _entityVal . _companyAvsId + let compId = res_cmp ^. _entityVal . _companyAvsId + uniq_cmp = if compId > 0 then UniqueCompanyAvsId compId + else UniqueCompanyName $ res_cmp ^. _entityVal . _companyName updateBy uniq_cmp [key_up] -- this is ok, since we have OnUpdateCascade on all CompanyId entries maybeM (return res_cmp) return $ getBy uniq_cmp - where - firmInfo2key = + firmInfo2key = CheckUpdate CompanyShorthand $ _avsFirmAbbreviation . from _CI -- Updating primary key works in principle thanks to OnUpdateCascade, but fails due to update get + firmInfo2companyUniques = + [ CheckUpdate CompanyName $ _avsFirmFirm . from _CI -- Updating unique turned out to be problematic, who would have thought! + , CheckUpdate CompanyAvsId _avsFirmFirmNo -- Updating unique turned out to be problematic, who would have thought! + ] firmInfo2company = - [ CheckUpdate CompanyName $ _avsFirmFirm . from _CI - , CheckUpdate CompanyAvsId _avsFirmFirmNo -- Updating unique might be problematic - -- , CheckUpdate CompanyPrefersPostal _avsFirmPrefersPostal -- Guessing here is not useful, since postal preference is ignored anyway when there is only one option available - , CheckUpdate CompanyPostAddress _avsFirmPostAddress + [ CheckUpdate CompanyPostAddress _avsFirmPostAddress , CheckUpdate CompanyEmail $ _avsFirmPrimaryEmail . _Just . from _CI . re _Just + -- , CheckUpdate CompanyPrefersPostal _avsFirmPrefersPostal -- Guessing here is not useful, since postal preference is ignored anyway when there is only one option available ] diff --git a/src/Utils/DB.hs b/src/Utils/DB.hs index 6420dccc2..e624ef497 100644 --- a/src/Utils/DB.hs +++ b/src/Utils/DB.hs @@ -364,4 +364,28 @@ updateRecord :: PersistEntity record => record -> iraw -> CheckUpdate record ira updateRecord ent new (CheckUpdate up l) = let newval = new ^. l lensRec = fieldLensVal up - in ent & lensRec .~ newval \ No newline at end of file + in ent & lensRec .~ newval + +-- | like mkUpdate' but only returns the update if the new value would be unique +-- mkUpdateCheckUnique' :: PersistEntity record => record -> iraw -> Maybe iraw -> CheckUpdate record iraw -> DB (Maybe (Update record)) + +mkUpdateCheckUnique' :: (MonadIO m, PersistQueryRead backend, PersistEntity record, PersistEntityBackend record ~ BaseBackend backend) + => record -> a -> Maybe a -> CheckUpdate record a -> ReaderT backend m (Maybe (Update record)) + +mkUpdateCheckUnique' ent new Nothing (CheckUpdate up l) + | let newval = new ^. l + , let entval = ent ^. fieldLensVal up + , newval /= entval + = do + newval_exists <- exists [up ==. newval] + return $ toMaybe (not newval_exists) (up =. newval) +mkUpdateCheckUnique' ent new (Just old) (CheckUpdate up l) + | let newval = new ^. l + , let oldval = old ^. l + , let entval = ent ^. fieldLensVal up + , newval /= entval + , oldval == entval + = do + newval_exists <- exists [up ==. newval] + return $ toMaybe (not newval_exists) (up =. newval) +mkUpdateCheckUnique' _ _ _ _ = return Nothing