chore(avs): show only 200 avs synch diffs per table - workaround pagination
This commit is contained in:
Steffen Jost
parent
4214c164c4
commit
f69b9eef13
@ -324,7 +324,7 @@ getProblemAvsSynchR = do
|
||||
case btnUnknownRes of
|
||||
Nothing -> return ()
|
||||
(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)
|
||||
--TODO: continue here!
|
||||
--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 errs) $ addMessageModal Error (i18n MsgAvsCommunicationError) (Right (text2widget $ tshow errs ))
|
||||
addMessageI ms $ MsgAvsImportIDs oks numUnknownLicenceOwners
|
||||
redirect ProblemAvsSynchR
|
||||
-- redirect ProblemAvsSynchR
|
||||
|
||||
(Just BtnRevokeAvsLicences) -> catchAllAvs $ do
|
||||
let revokes = Set.map (AvsPersonLicence AvsNoLicence) $ Set.fromList unknownLicenceOwners
|
||||
@ -345,7 +345,7 @@ getProblemAvsSynchR = do
|
||||
if oks < no_revokes
|
||||
then addMessageI Error MsgRevokeUnknownLicencesFail
|
||||
else addMessageI Info MsgRevokeUnknownLicencesOk
|
||||
redirect ProblemAvsSynchR
|
||||
-- redirect ProblemAvsSynchR
|
||||
|
||||
-- licence differences
|
||||
((tres0,tb0),(tres1up,tb1up),(tres1down,tb1down),(tres2,tb2)) <- runDB $ (,,,)
|
||||
@ -353,12 +353,6 @@ getProblemAvsSynchR = do
|
||||
<*> mkLicenceTable "avsLicDiffGrantVorfeld" AvsNoLicence avsLicenceDiffGrantVorfeld
|
||||
<*> mkLicenceTable "avsLicDiffRevokeRollfeld" AvsLicenceRollfeld avsLicenceDiffRevokeRollfeld
|
||||
<*> 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
|
||||
let nowaday = utctDay now
|
||||
procRes :: AvsLicence -> (LicenceTableActionData, Set AvsPersonId) -> Handler ()
|
||||
@ -390,7 +384,7 @@ getProblemAvsSynchR = do
|
||||
liftHandler $ addMessageI Error $ MsgRevokeFraDriveLicences alic oks
|
||||
else
|
||||
liftHandler $ addMessageI Success $ MsgRevokeFraDriveLicences alic oks
|
||||
redirect ProblemAvsSynchR -- must be outside runDB
|
||||
-- redirect ProblemAvsSynchR -- must be outside runDB
|
||||
|
||||
procRes _alic (LicenceTableGrantFDriveData{..}, apids ) = do
|
||||
(n, Qualification{qualificationShorthand}) <- runDB $ do
|
||||
@ -400,7 +394,7 @@ getProblemAvsSynchR = do
|
||||
forM_ uids $ upsertQualificationUser licenceTableChangeFDriveQId nowaday licenceTableChangeFDriveEnd
|
||||
(length uids,) <$> get404 licenceTableChangeFDriveQId
|
||||
addMessageI Success $ MsgSetFraDriveLicences (citext2string qualificationShorthand) n
|
||||
redirect ProblemAvsSynchR -- must be outside runDB
|
||||
-- redirect ProblemAvsSynchR -- must be outside runDB
|
||||
|
||||
formResult tres2 $ procRes AvsLicenceRollfeld
|
||||
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.==. usrAvs E.^. UserAvsUser
|
||||
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)
|
||||
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
|
||||
dbtRowKey = queryUserAvs >>> (E.^. UserAvsPersonId) -- ) &&& (queryQualification >>> (E.?. QualificationId)) -- WHY IS THIS AN ERROR?
|
||||
-- Not sure what changes here:
|
||||
-- dbtProj = dbtProjId -- Simple $ \(userAvs, user, qualUsr, quali) -> return (userAvs, user, qualUsr, quali)
|
||||
dbtProj = dbtProjFilteredPostId
|
||||
dbtColonnade = mconcat
|
||||
[ dbSelect (applying _2) id $ return . view (resultUserAvs . _userAvsPersonId)
|
||||
|
||||
@ -201,13 +201,14 @@ computeDifferingLicences = fmap avsLicenceDifferences2personLicences . getDiffer
|
||||
retrieveDifferingLicences :: Handler AvsLicenceDifferences
|
||||
retrieveDifferingLicences = do
|
||||
#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 AvsLicenceRollfeld $ AvsPersonId 12345678 -- AVS:2 FD:1
|
||||
, AvsPersonLicence AvsLicenceVorfeld $ AvsPersonId 5 -- AVS:1 FD:0 (nichts)
|
||||
, AvsPersonLicence AvsLicenceVorfeld $ AvsPersonId 2 -- AVS:1 FD:0 (ungültig)
|
||||
-- , AvsPersonLicence AvsLicenceVorfeld $ AvsPersonId 4 -- AVS:1 FD:1
|
||||
]
|
||||
] ++ [AvsPersonLicence AvsLicenceVorfeld avsid | Entity _ UserAvs{userAvsPersonId = avsid} <- avsUsrs]
|
||||
#else
|
||||
AvsQuery{..} <- maybeThrowM AvsInterfaceUnavailable $ getsYesod $ view _appAvsQuery
|
||||
allLicences <- throwLeftM avsQueryGetAllLicences
|
||||
|
||||
@ -4,6 +4,12 @@ $# SPDX-FileCopyrightText: 2022 Steffen Jost <jost@tcs.ifi.lmu.de>
|
||||
$#
|
||||
$# 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>
|
||||
<h2>
|
||||
|
||||
@ -417,6 +417,8 @@ fillDb = do
|
||||
Nothing -> repack [st|#{firstName}.#{userSurname}@example.invalid|]
|
||||
matrikel <- toMatrikel <$> getRandomRs (0 :: Int, 9 :: Int)
|
||||
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
|
||||
tmax = 2
|
||||
|
||||
Loading…
Reference in New Issue
Block a user