fraport/fradrive
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fix(avs): company update checks uniques and ignores those updates if necessary

Browse Source
This commit is contained in:
Steffen Jost 2024-05-23 17:08:30 +02:00
parent ff2347b1c9
commit 9451d90a9e
2 changed files with 45 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -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
]

26
src/Utils/DB.hs
View File

@ -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
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