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

fix(build): minor error non-development code

Browse Source
This commit is contained in:
Steffen Jost 2024-03-13 11:23:25 +01:00
parent 724e4a0bec
commit 66eaa4f7dc
1 changed files with 20 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -435,8 +435,8 @@ data CheckAvsUpdate record iavs = forall typ. (Eq typ, PersistField typ) => Chec
-- | Compute necessary updates. Given an database record, a new and an old avs response and a pair consisting of a getter from avs response to a value and and EntityField of the same value, -- | Compute necessary updates. Given an database record, a new and an old avs response and a pair consisting of a getter from avs response to a value and and EntityField of the same value,
-- an update is returned, if the current value is identical to the old avs value, which changed in the new avs query -- an update is returned, if the current value is identical to the old avs value, which changed in the new avs query
mkUpdate :: PersistEntity record => record -> iavs -> iavs -> CheckAvsUpdate record iavs -> Maybe (Update record) mkUpdate :: PersistEntity record => record -> iavs -> Maybe iavs -> CheckAvsUpdate record iavs -> Maybe (Update record)
mkUpdate ent newapi oldapi (CheckAvsUpdate up la) mkUpdate ent newapi (Just oldapi) (CheckAvsUpdate up la)
| let newval = newapi ^. la | let newval = newapi ^. la
, let oldval = oldapi ^. la , let oldval = oldapi ^. la
, let entval = getField up ent , let entval = getField up ent
@ -480,7 +480,7 @@ updateAvsUserByIds apids = do
let usrId = userAvsUser usravs let usrId = userAvsUser usravs
usr <- MaybeT $ get usrId usr <- MaybeT $ get usrId
now <- liftIO getCurrentTime now <- liftIO getCurrentTime
let per_ups = maybeEmpty oldAvsPersonInfo $ \oldAvsPersonInfo' -> mapMaybe (mkUpdate usr newAvsPersonInfo oldAvsPersonInfo') let per_ups = mapMaybe (mkUpdate usr newAvsPersonInfo oldAvsPersonInfo) -- NOTE: Updates erfolgen nur, wenn der Alt-Wert identisch zu Aktuellem-Wert sind! Bei mehreren Update-Möglichkeiten für ein Feld kann nur eines zutreffen.
[ CheckAvsUpdate UserFirstName _avsInfoFirstName [ CheckAvsUpdate UserFirstName _avsInfoFirstName
, CheckAvsUpdate UserSurname _avsInfoLastName , CheckAvsUpdate UserSurname _avsInfoLastName
, CheckAvsUpdate UserDisplayName _avsInfoDisplayName , CheckAvsUpdate UserDisplayName _avsInfoDisplayName
@ -489,16 +489,14 @@ updateAvsUserByIds apids = do
, CheckAvsUpdate UserMatrikelnummer $ _avsInfoPersonNo . re _Just -- Maybe im User, aber nicht im AvsInfo; also: `re _Just` work like `to Just` , CheckAvsUpdate UserMatrikelnummer $ _avsInfoPersonNo . re _Just -- Maybe im User, aber nicht im AvsInfo; also: `re _Just` work like `to Just`
, CheckAvsUpdate UserCompanyPersonalNumber $ _avsInfoInternalPersonalNo . _Just . _avsInternalPersonalNo . re _Just -- Maybe im User und im AvsInfo , CheckAvsUpdate UserCompanyPersonalNumber $ _avsInfoInternalPersonalNo . _Just . _avsInternalPersonalNo . re _Just -- Maybe im User und im AvsInfo
] ]
eml_up = let -- Comm > Superior > Company > Personal; NOTE: Email update depends simultaneously on AvsFirmInfo and AvsPersonInfo em_p_up = mkUpdate usr newAvsPersonInfo oldAvsPersonInfo $
eml_old = (oldAvsFirmInfo ^. _Just . _avsFirmPrimaryEmail) <|> (oldAvsPersonInfo ^. _Just . _avsInfoPersonEMail) CheckAvsUpdate UserDisplayEmail $ _avsInfoPersonEMail . to (fromMaybe mempty) . from _CI -- Maybe im AvsInfo, aber nicht im User
eml_new = (newAvsFirmInfo ^. _avsFirmPrimaryEmail) <|> (newAvsPersonInfo ^. _avsInfoPersonEMail) em_f_up = mkUpdate usr newAvsFirmInfo oldAvsFirmInfo $ -- Email updates erfolgen nur, wenn identisch. Für Firmen-Email leer lassen.
in mkUpdate usr eml_new eml_old $ CheckAvsUpdate UserDisplayEmail $ _avsFirmPrimaryEmail . to (fromMaybe mempty) . from _CI
CheckAvsUpdate UserDisplayEmail $ to (fromMaybe mempty) . from _CI -- Maybe nicht im User, aber im AvsInfo PROBLEM: Hängt auch von der FirmenEmail ab und muss daher im Verbund betrachtet werden. eml_up = em_p_up <|> em_f_up -- ensure that only one email update is produced; there is no Eq instance for the Update type
-- Note: company address no longer stored with each individual user; referenced with UserCompany instead frm_up = mkUpdate usr newAvsFirmInfo oldAvsFirmInfo $ -- Legacy, if company postal is stored in user; should no longer be true for new users,
-- frm_ups = maybeEmpty oldAvsFirmInfo $ \oldAvsFirmInfo' -> mapMaybe (mkUpdate usr newAvsFirmInfo oldAvsFirmInfo') CheckAvsUpdate UserPostAddress _avsFirmPostAddress -- since company address should now be referenced with UserCompany instead
-- [ CheckAvsUpdate UserPostAddress _avsFirmPostAddress usr_ups = eml_up `mcons` (frm_up `mcons` per_ups)
-- ]
usr_ups = mcons eml_up per_ups -- <> frm_ups
avs_ups = ((UserAvsNoPerson =.) <$> readMay (avsInfoPersonNo newAvsPersonInfo)) `mcons` avs_ups = ((UserAvsNoPerson =.) <$> readMay (avsInfoPersonNo newAvsPersonInfo)) `mcons`
[ UserAvsLastSynch =. now [ UserAvsLastSynch =. now
, UserAvsLastSynchError =. Nothing , UserAvsLastSynchError =. Nothing
@ -506,7 +504,7 @@ updateAvsUserByIds apids = do
, UserAvsLastFirmInfo =. Just newAvsFirmInfo , UserAvsLastFirmInfo =. Just newAvsFirmInfo
] ]
-- --
lift $ do -- no more maybe here lift $ do -- no more maybeT neeed from here
update usrId usr_ups update usrId usr_ups
oldCompanyMb <- join <$> (getAvsCompany `traverse` oldAvsFirmInfo) oldCompanyMb <- join <$> (getAvsCompany `traverse` oldAvsFirmInfo)
let oldCompanyId = entityKey <$> oldCompanyMb let oldCompanyId = entityKey <$> oldCompanyMb
@ -578,7 +576,7 @@ upsertAvsCompany newAvsFirmInfo mbOldAvsFirmInfo = do
case (mbFirmEnt, mbOldAvsFirmInfo) of case (mbFirmEnt, mbOldAvsFirmInfo) of
(Nothing, _) -> do -- insert new company (Nothing, _) -> do -- insert new company
let upd = flip updateRecord newAvsFirmInfo let upd = flip updateRecord newAvsFirmInfo
dmy = Company dmy = Company -- mostly dummy, values are actually prodcued 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 = newAvsFirmInfo ^. _avsFirmFirmNo , companyAvsId = newAvsFirmInfo ^. _avsFirmFirmNo
@ -588,11 +586,7 @@ upsertAvsCompany newAvsFirmInfo mbOldAvsFirmInfo = do
} }
insert $ foldl' upd dmy firmInfo2company insert $ foldl' upd dmy firmInfo2company
(Just Entity{entityKey=firmid }, Nothing) -> do -- neither insert nor update; update impossible without old comparison values, since company could have been edited (Just Entity{entityKey=firmid, entityVal=firm}, oldAvsFirmInfo) -> do -- possibly update existing company, if isJust oldAvsFirmInfo and changed occurred
$logWarnS "AVS" $ "upsertAvsCompany: neither insert nor update. Received existing company " <> (newAvsFirmInfo ^. _avsFirmFirm) <> " without old comparison value for update."
return firmid
(Just Entity{entityKey=firmid, entityVal=firm}, Just oldAvsFirmInfo) -> do -- possibly update existing company
let cmp_ups = mapMaybe (mkUpdate firm newAvsFirmInfo oldAvsFirmInfo) firmInfo2company let cmp_ups = mapMaybe (mkUpdate firm newAvsFirmInfo oldAvsFirmInfo) firmInfo2company
update firmid cmp_ups update firmid cmp_ups
return firmid return firmid
@ -733,12 +727,11 @@ retrieveDifferingLicences' getStatus = do
#else #else
let statQry = avsLicenceDifferences2LicenceIds lDiff let statQry = avsLicenceDifferences2LicenceIds lDiff
lStat <- if getStatus && notNull statQry lStat <- if getStatus && notNull statQry
then -- throwLeftM $ avsQueryStatus $ AvsQueryStatus statQry -- don't throw up here, licence differences are too important! TODO: Warn in Problem-Handler then avsQueryNoCache (AvsQueryStatus statQry)
avsQueryStatus (AvsQueryStatus statQry) >>= \case -- `catch` handler
Left err -> do -- let handler _exception = do
addMessage Error $ toHtml $ "avsQueryStatus failed for " <> tshow (length statQry) <> " requests with: \n" <> tshow err <> "\nREQUEST:\n" <> tshow statQry -- addMessage Error $ toHtml $ "avsQueryStatus failed for " <> tshow (length statQry) <> " requests with: \n" <> tshow err <> "\nREQUEST:\n" <> tshow statQry
return $ AvsResponseStatus mempty -- return $ AvsResponseStatus mempty
Right res -> return res
else return $ AvsResponseStatus mempty -- avoid unnecessary avs calls else return $ AvsResponseStatus mempty -- avoid unnecessary avs calls
#endif #endif
return (lDiff, avsResponseStatusMap lStat) return (lDiff, avsResponseStatusMap lStat)