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

fix(avs): company update no longer fails on duplicate key

Browse Source
This commit is contained in:
Steffen Jost 2024-06-10 14:56:33 +02:00
parent e553ad4358
commit bb101dee7b
4 changed files with 49 additions and 41 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
models/company.model
View File

@ -11,15 +11,8 @@ Company
prefersPostal Bool default=false -- new company users prefers letters by post instead of email
postAddress StoredMarkup Maybe -- default company postal address, including company name
email UserEmail Maybe -- Case-insensitive generic company eMail address
UniqueCompanyName name
-- UniqueCompanyName name -- Should be Unique in AVS, but we do not yet need to enforce it
-- UniqueCompanyShorthand shorthand -- unnecessary, since it is the primary key already
UniqueCompanyAvsId avsId
Primary shorthand -- newtype Key Company = CompanyKey { unCompanyKey :: CompanyShorthand }
UniqueCompanyAvsId avsId -- Should be the key, is not for historical reasons and for convenience in URLs and columns
Primary shorthand -- newtype Key Company = CompanyKey { unCompanyKey :: CompanyShorthand }
deriving Ord Eq Show Generic Binary
-- -- TODO: a way to populate this table (manually)
-- CompanySynonym
-- synonym CompanyName
-- canonical CompanyShorthand OnDeleteCascade OnUpdateCascade -- DEPRECATED: should be CompanyId
-- UniqueCompanySynonym synonym
-- deriving Ord Eq Show Generic

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

@ -565,16 +565,18 @@ repsertSuperiorSupervisor cid afi uid =
-- | Query DB from given AvsFirmInfo. Guarantees that all Uniqueness-Constraints are checked. Highly unlikely that Nothing is returned, since all AvsResponseContact always contains an AvsFirmInfo
getAvsCompany :: AvsFirmInfo -> DB (Maybe (Entity Company))
getAvsCompany afi =
let compName :: CompanyName
let compName :: CompanyName
compName = afi ^. _avsFirmFirm . from _CI
compShorthand :: CompanyShorthand
compShorthand = afi ^. _avsFirmAbbreviation . from _CI
compAvsId = afi ^. _avsFirmFirmNo
in firstJustM $
bcons (compAvsId > 0)
( getBy $ UniqueCompanyAvsId compAvsId )
[ getBy $ UniqueCompanyName compName
, getEntity $ CompanyKey compShorthand
in firstJustM $ -- legacy treatment, only use UniqueCompnayAvsId in the future
guardMonoid (compAvsId > 0)
[ getBy $ UniqueCompanyAvsId compAvsId
, getEntity $ CompanyKey $ compShorthand <> "-" <> ciShow compAvsId
] <>
[ getByFilter [CompanyName ==. compName]
, getEntity $ CompanyKey compShorthand
]
-- | insert a company from AVS firm info or update an existing one based on previous values
@ -583,17 +585,20 @@ 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, Shorthand or Name are known to exist
let upd = flip updateRecord newAvsFirmInfo
(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
{ companyName = newAvsFirmInfo ^. _avsFirmFirm . from _CI
, companyShorthand = newAvsFirmInfo ^. _avsFirmAbbreviation . from _CI
, companyAvsId = newAvsFirmInfo ^. _avsFirmFirmNo
, companyAvsId = afn
, companyPrefersPostal = True
, companyPostAddress = newAvsFirmInfo ^. _avsFirmPostAddress
, companyEmail = newAvsFirmInfo ^? _avsFirmPrimaryEmail . _Just . from _CI
}
cmp = foldl' upd dmy $ firmInfo2key : firmInfo2companyUniques <> firmInfo2company
cmp = foldl' upd dmy $ firmInfo2key : firmInfo2companyNo : firmInfo2company
$logInfoS "AVS" $ "Insert new company: " <> tshow cmp
newCmp <- insertEntity cmp
reportAdminProblem $ AdminProblemNewCompany $ entityKey newCmp
@ -603,30 +608,33 @@ upsertAvsCompany newAvsFirmInfo mbOldAvsFirmInfo = do
(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
uniq_ups <- maybeMapM (mkUpdateCheckUnique' firm newAvsFirmInfo oldAvsFirmInfo) firmInfo2companyUniques
$logInfoS "AVS" [st|Update company #{companyShorthand firm}: #{tshow (length cmp_ups)}, #{tshow (length key_ups)}, #{tshow (length uniq_ups)} for #{tshow newAvsFirmInfo}|]
res_cmp <- updateGetEntity firmid $ cmp_ups <> uniq_ups
case key_ups of
Nothing -> do
$logInfoS "AVS" "Update new company completed."
return res_cmp
Just key_up -> do
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
$logInfoS "AVS" "Update new company completed."
maybeM (return res_cmp) return $ getBy uniq_cmp
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}|]
res_cmp <- updateGetEntity firmid $ mcons uniq_ups cmp_ups
let cmp_id = res_cmp ^. _entityVal . _companyAvsId
res_cmp2 <- case key_ups of
Just key_up | cmp_id > 0 -> do
$logInfoS "AVS" $ "Updating CompanyShorthand from " <> ciOriginal (companyShorthand firm) <> " to " <> avsFirmAbbreviation newAvsFirmInfo <> " for AvsNo " <> tshow cmp_id
let uniq_cmp = UniqueCompanyAvsId cmp_id
cmp_key = newAvsFirmInfo ^. _avsFirmAbbreviation . from _CI
alt_key = cmp_key <> "-" <> ciShow cmp_id
key_ok <- notExists [CompanyShorthand ==. cmp_key]
alt_ok <- notExists [CompanyShorthand ==. alt_key]
if | key_ok -> updateBy uniq_cmp [key_up] -- this is ok, since we have OnUpdateCascade on all CompanyId entries
| alt_ok -> updateBy uniq_cmp [CompanyShorthand =. 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
_otherwise -> return res_cmp
$logInfoS "AVS" "Update company completed."
return res_cmp2
where
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!
]
firmInfo2companyNo =
CheckUpdate CompanyAvsId _avsFirmFirmNo -- Updating a unique needs special considerations; AVS does not update FirmNo, but for legacy reasons we might have companies without a number
firmInfo2company =
[ CheckUpdate CompanyPostAddress _avsFirmPostAddress
[ CheckUpdate CompanyName $ _avsFirmFirm . from _CI
, 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
]

4
src/Utils.hs
View File

@ -710,6 +710,10 @@ bcons :: Bool -> a -> [a] -> [a]
bcons False _ = id
bcons True x = (x:)
bsnoc :: Bool -> a -> [a] -> [a]
bsnoc False _ xs = xs
bsnoc True x xs = xs ++ [x]
-- | Merge/Add any attribute-value pair to an existing list of such pairs.
-- If the attribute exists, the new valu will be prepended, separated by a single empty space
insertAttr :: Text -> Text -> [(Text,Text)] -> [(Text,Text)]

5
src/Utils/DB.hs
View File

@ -82,6 +82,9 @@ getEntity404 :: (PersistStoreRead backend, PersistRecordBackend record backend,
=> Key record -> ReaderT backend m (Entity record)
getEntity404 k = Entity k <$> get404 k
notExists :: (PersistRecordBackend record backend, PersistQueryRead backend, MonadIO m) => [Filter record] -> ReaderT backend m Bool
notExists = fmap not . exists
existsBy :: (PersistRecordBackend record backend, PersistUniqueRead backend, MonadIO m)
=> Unique record -> ReaderT backend m Bool
existsBy = fmap (is _Just) . getKeyBy
@ -108,6 +111,7 @@ existsKey404 :: (PersistRecordBackend record backend, PersistQueryRead backend,
existsKey404 = bool notFound (return ()) <=< existsKey
-- | given filter criteria like `selectList` this function returns Just if and only if there is precisely one result
-- getByPeseudoUnique
getByFilter :: (PersistRecordBackend record backend, PersistQueryRead backend, MonadIO m)
=> [Filter record] -> ReaderT backend m (Maybe (Entity record))
getByFilter crit =
@ -368,7 +372,6 @@ updateRecord ent new (CheckUpdate up l) =
-- | 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))