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

chore(avs): show only 200 avs synch diffs per table - workaround pagination

Browse Source
This commit is contained in:
Steffen Jost 2023-01-11 17:32:14 +01:00
parent 4214c164c4
commit f69b9eef13
4 changed files with 20 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
src/Handler/Admin/Avs.hs
View File

@ -324,7 +324,7 @@ getProblemAvsSynchR = do
case btnUnknownRes of case btnUnknownRes of
Nothing -> return () Nothing -> return ()
(Just BtnImportUnknownAvsIds) -> catchAllAvs $ do (Just BtnImportUnknownAvsIds) -> catchAllAvs $ do
res <- forM unknownLicenceOwners $ try . upsertAvsUserById res <- forM (take 500 unknownLicenceOwners) $ try . upsertAvsUserById -- TODO: turn this into a background job
let procRes (Right _) = (Sum 1, mempty :: Set.Set AvsPersonId, mempty :: Set.Set AvsPersonId, mempty) let procRes (Right _) = (Sum 1, mempty :: Set.Set AvsPersonId, mempty :: Set.Set AvsPersonId, mempty)
--TODO: continue here! --TODO: continue here!
--procRes (Left (AvsUserAmbiguous api)) = (Sum 0, Set.singleton api, mempty, mempty) --procRes (Left (AvsUserAmbiguous api)) = (Sum 0, Set.singleton api, mempty, mempty)
@ -336,7 +336,7 @@ getProblemAvsSynchR = do
unless (null unkns) $ addMessageModal Error (i18n $ MsgAvsImportUnknowns $ length unkns) (Right (text2widget $ tshow unkns)) unless (null unkns) $ addMessageModal Error (i18n $ MsgAvsImportUnknowns $ length unkns) (Right (text2widget $ tshow unkns))
unless (null errs) $ addMessageModal Error (i18n MsgAvsCommunicationError) (Right (text2widget $ tshow errs )) unless (null errs) $ addMessageModal Error (i18n MsgAvsCommunicationError) (Right (text2widget $ tshow errs ))
addMessageI ms $ MsgAvsImportIDs oks numUnknownLicenceOwners addMessageI ms $ MsgAvsImportIDs oks numUnknownLicenceOwners
redirect ProblemAvsSynchR -- redirect ProblemAvsSynchR
(Just BtnRevokeAvsLicences) -> catchAllAvs $ do (Just BtnRevokeAvsLicences) -> catchAllAvs $ do
let revokes = Set.map (AvsPersonLicence AvsNoLicence) $ Set.fromList unknownLicenceOwners let revokes = Set.map (AvsPersonLicence AvsNoLicence) $ Set.fromList unknownLicenceOwners
@ -345,7 +345,7 @@ getProblemAvsSynchR = do
if oks < no_revokes if oks < no_revokes
then addMessageI Error MsgRevokeUnknownLicencesFail then addMessageI Error MsgRevokeUnknownLicencesFail
else addMessageI Info MsgRevokeUnknownLicencesOk else addMessageI Info MsgRevokeUnknownLicencesOk
redirect ProblemAvsSynchR -- redirect ProblemAvsSynchR
-- licence differences -- licence differences
((tres0,tb0),(tres1up,tb1up),(tres1down,tb1down),(tres2,tb2)) <- runDB $ (,,,) ((tres0,tb0),(tres1up,tb1up),(tres1down,tb1down),(tres2,tb2)) <- runDB $ (,,,)
@ -353,12 +353,6 @@ getProblemAvsSynchR = do
<*> mkLicenceTable "avsLicDiffGrantVorfeld" AvsNoLicence avsLicenceDiffGrantVorfeld <*> mkLicenceTable "avsLicDiffGrantVorfeld" AvsNoLicence avsLicenceDiffGrantVorfeld
<*> mkLicenceTable "avsLicDiffRevokeRollfeld" AvsLicenceRollfeld avsLicenceDiffRevokeRollfeld <*> mkLicenceTable "avsLicDiffRevokeRollfeld" AvsLicenceRollfeld avsLicenceDiffRevokeRollfeld
<*> mkLicenceTable "avsLicDiffGrantRollfeld" AvsNoLicence avsLicenceDiffGrantRollfeld <*> mkLicenceTable "avsLicDiffGrantRollfeld" AvsNoLicence avsLicenceDiffGrantRollfeld
#ifdef DEVELOPMENT
addMessage Info $ text2Html $ "0: " <> tshow tres0 -- DEBUG
addMessage Info $ text2Html $ "1u: " <> tshow tres1up -- DEBUG
addMessage Info $ text2Html $ "1d: " <> tshow tres1down -- DEBUG
addMessage Info $ text2Html $ "2: " <> tshow tres2 -- DEBUG
#endif
now <- liftIO getCurrentTime now <- liftIO getCurrentTime
let nowaday = utctDay now let nowaday = utctDay now
procRes :: AvsLicence -> (LicenceTableActionData, Set AvsPersonId) -> Handler () procRes :: AvsLicence -> (LicenceTableActionData, Set AvsPersonId) -> Handler ()
@ -390,7 +384,7 @@ getProblemAvsSynchR = do
liftHandler $ addMessageI Error $ MsgRevokeFraDriveLicences alic oks liftHandler $ addMessageI Error $ MsgRevokeFraDriveLicences alic oks
else else
liftHandler $ addMessageI Success $ MsgRevokeFraDriveLicences alic oks liftHandler $ addMessageI Success $ MsgRevokeFraDriveLicences alic oks
redirect ProblemAvsSynchR -- must be outside runDB -- redirect ProblemAvsSynchR -- must be outside runDB
procRes _alic (LicenceTableGrantFDriveData{..}, apids ) = do procRes _alic (LicenceTableGrantFDriveData{..}, apids ) = do
(n, Qualification{qualificationShorthand}) <- runDB $ do (n, Qualification{qualificationShorthand}) <- runDB $ do
@ -400,7 +394,7 @@ getProblemAvsSynchR = do
forM_ uids $ upsertQualificationUser licenceTableChangeFDriveQId nowaday licenceTableChangeFDriveEnd forM_ uids $ upsertQualificationUser licenceTableChangeFDriveQId nowaday licenceTableChangeFDriveEnd
(length uids,) <$> get404 licenceTableChangeFDriveQId (length uids,) <$> get404 licenceTableChangeFDriveQId
addMessageI Success $ MsgSetFraDriveLicences (citext2string qualificationShorthand) n addMessageI Success $ MsgSetFraDriveLicences (citext2string qualificationShorthand) n
redirect ProblemAvsSynchR -- must be outside runDB -- redirect ProblemAvsSynchR -- must be outside runDB
formResult tres2 $ procRes AvsLicenceRollfeld formResult tres2 $ procRes AvsLicenceRollfeld
formResult tres1down $ procRes AvsLicenceVorfeld formResult tres1down $ procRes AvsLicenceVorfeld
@ -468,9 +462,11 @@ mkLicenceTable dbtIdent aLic apids = do
E.on $ user E.^. UserId E.=?. qualUser E.?. QualificationUserUser E.on $ user E.^. UserId E.=?. qualUser E.?. QualificationUserUser
E.on $ user E.^. UserId E.==. usrAvs E.^. UserAvsUser E.on $ user E.^. UserId E.==. usrAvs E.^. UserAvsUser
E.where_ $ fltrLic qual E.&&. (usrAvs E.^. UserAvsPersonId `E.in_` E.vals apids) E.where_ $ fltrLic qual E.&&. (usrAvs E.^. UserAvsPersonId `E.in_` E.vals apids)
E.limit 200 -- TODO: why does pagination not work here?
return (usrAvs, user, qualUser, qual) return (usrAvs, user, qualUser, qual)
dbtRowKey = queryUserAvs >>> (E.^. UserAvsPersonId) -- &&& (queryQualification >>> (E.?. QualificationId)) -- WHY IS THIS AN ERROR? dbtRowKey = queryUserAvs >>> (E.^. UserAvsPersonId) -- ) &&& (queryQualification >>> (E.?. QualificationId)) -- WHY IS THIS AN ERROR?
--dbtProj = dbtProjSimple $ \(user, qualUsr, E.Value api, quali) -> return (user, qualUsr, api, quali) -- just remove Value wrapper in 3rd element -- Not sure what changes here:
-- dbtProj = dbtProjId -- Simple $ \(userAvs, user, qualUsr, quali) -> return (userAvs, user, qualUsr, quali)
dbtProj = dbtProjFilteredPostId dbtProj = dbtProjFilteredPostId
dbtColonnade = mconcat dbtColonnade = mconcat
[ dbSelect (applying _2) id $ return . view (resultUserAvs . _userAvsPersonId) [ dbSelect (applying _2) id $ return . view (resultUserAvs . _userAvsPersonId)

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

@ -201,13 +201,14 @@ computeDifferingLicences = fmap avsLicenceDifferences2personLicences . getDiffer
retrieveDifferingLicences :: Handler AvsLicenceDifferences retrieveDifferingLicences :: Handler AvsLicenceDifferences
retrieveDifferingLicences = do retrieveDifferingLicences = do
#ifdef DEVELOPMENT #ifdef DEVELOPMENT
getDifferingLicences $ AvsResponseGetLicences $ Set.fromList -- DEBUG ONLY avsUsrs <- runDB $ selectList [] [LimitTo 444]
getDifferingLicences $ AvsResponseGetLicences $ Set.fromList $
[ AvsPersonLicence AvsLicenceVorfeld $ AvsPersonId 77 -- AVS:1 FD:2 [ AvsPersonLicence AvsLicenceVorfeld $ AvsPersonId 77 -- AVS:1 FD:2
, AvsPersonLicence AvsLicenceRollfeld $ AvsPersonId 12345678 -- AVS:2 FD:1 , AvsPersonLicence AvsLicenceRollfeld $ AvsPersonId 12345678 -- AVS:2 FD:1
, AvsPersonLicence AvsLicenceVorfeld $ AvsPersonId 5 -- AVS:1 FD:0 (nichts) , AvsPersonLicence AvsLicenceVorfeld $ AvsPersonId 5 -- AVS:1 FD:0 (nichts)
, AvsPersonLicence AvsLicenceVorfeld $ AvsPersonId 2 -- AVS:1 FD:0 (ungültig) , AvsPersonLicence AvsLicenceVorfeld $ AvsPersonId 2 -- AVS:1 FD:0 (ungültig)
-- , AvsPersonLicence AvsLicenceVorfeld $ AvsPersonId 4 -- AVS:1 FD:1 -- , AvsPersonLicence AvsLicenceVorfeld $ AvsPersonId 4 -- AVS:1 FD:1
] ] ++ [AvsPersonLicence AvsLicenceVorfeld avsid | Entity _ UserAvs{userAvsPersonId = avsid} <- avsUsrs]
#else #else
AvsQuery{..} <- maybeThrowM AvsInterfaceUnavailable $ getsYesod $ view _appAvsQuery AvsQuery{..} <- maybeThrowM AvsInterfaceUnavailable $ getsYesod $ view _appAvsQuery
allLicences <- throwLeftM avsQueryGetAllLicences allLicences <- throwLeftM avsQueryGetAllLicences

6
templates/i18n/avs-synchronisation/de-de-formal.hamlet
View File

@ -4,6 +4,12 @@ $# SPDX-FileCopyrightText: 2022 Steffen Jost <jost@tcs.ifi.lmu.de>
$# $#
$# SPDX-License-Identifier: AGPL-3.0-or-later $# SPDX-License-Identifier: AGPL-3.0-or-later
<sectio>
<h1>
HINWEIS
<p>
Momentan werden aus Effizienzgründen alle Tabellen beschnitten und abgekürzt.
Auch die Funktion zum Import unbekannter Führerscheininhaber ist auf ein paar Hundert beschränkt.
<section> <section>
<h2> <h2>

2
test/Database/Fill.hs
View File

@ -417,6 +417,8 @@ fillDb = do
Nothing -> repack [st|#{firstName}.#{userSurname}@example.invalid|] Nothing -> repack [st|#{firstName}.#{userSurname}@example.invalid|]
matrikel <- toMatrikel <$> getRandomRs (0 :: Int, 9 :: Int) matrikel <- toMatrikel <$> getRandomRs (0 :: Int, 9 :: Int)
manyUsers <- insertMany . getZipList $ manyUser <$> ZipList ((,,) <$> firstNames <*> middlenames <*> surnames) <*> ZipList matrikel manyUsers <- insertMany . getZipList $ manyUser <$> ZipList ((,,) <$> firstNames <*> middlenames <*> surnames) <*> ZipList matrikel
matUsers <- selectList [UserMatrikelnummer !=. Nothing] []
insertMany_ [UserAvs (AvsPersonId n) uid n | Entity uid User{userMatrikelnummer = fmap readMay -> Just (Just n)} <- matUsers]
let tmin = -1 let tmin = -1
tmax = 2 tmax = 2