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

chore(avs): attempts to fix pagination on avs synch resolve page

Browse Source
This commit is contained in:
Steffen Jost 2023-01-12 11:55:01 +01:00
parent daa1fe1a37
commit 306b54fa3e
2 changed files with 19 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -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,6 +353,7 @@ 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
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 ()
@ -384,7 +385,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
@ -394,7 +395,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
@ -406,24 +407,23 @@ getProblemAvsSynchR = do
$(i18nWidgetFile "avs-synchronisation") $(i18nWidgetFile "avs-synchronisation")
type LicenceTableExpr = ( E.SqlExpr (Entity UserAvs) type LicenceTableExpr = ( E.SqlExpr (Entity UserAvs)
`E.InnerJoin` E.SqlExpr (Entity User) `E.InnerJoin` E.SqlExpr (Entity User)
) `E.LeftOuterJoin` ( `E.LeftOuterJoin` E.SqlExpr (Maybe (Entity QualificationUser))
E.SqlExpr (Maybe (Entity QualificationUser)) `E.LeftOuterJoin` E.SqlExpr (Maybe (Entity Qualification))
`E.InnerJoin` E.SqlExpr (Maybe (Entity Qualification))
) )
queryUserAvs :: LicenceTableExpr -> E.SqlExpr (Entity UserAvs) queryUserAvs :: LicenceTableExpr -> E.SqlExpr (Entity UserAvs)
queryUserAvs = $(E.sqlIJproj 2 1) . $(E.sqlLOJproj 2 1) queryUserAvs = $(E.sqlIJproj 2 1) . $(E.sqlLOJproj 3 1)
queryUser :: LicenceTableExpr -> E.SqlExpr (Entity User) queryUser :: LicenceTableExpr -> E.SqlExpr (Entity User)
queryUser = $(E.sqlIJproj 2 2) . $(E.sqlLOJproj 2 1) queryUser = $(E.sqlIJproj 2 2) . $(E.sqlLOJproj 3 1)
queryQualUser :: LicenceTableExpr -> E.SqlExpr (Maybe (Entity QualificationUser)) queryQualUser :: LicenceTableExpr -> E.SqlExpr (Maybe (Entity QualificationUser))
queryQualUser = $(E.sqlIJproj 2 1) . $(E.sqlLOJproj 2 2) queryQualUser = $(E.sqlLOJproj 3 2)
queryQualification :: LicenceTableExpr -> E.SqlExpr (Maybe (Entity Qualification)) queryQualification :: LicenceTableExpr -> E.SqlExpr (Maybe (Entity Qualification))
queryQualification = $(E.sqlIJproj 2 2) . $(E.sqlLOJproj 2 2) queryQualification = $(E.sqlLOJproj 3 3)
type LicenceTableData = DBRow (Entity UserAvs, Entity User, Maybe (Entity QualificationUser), Maybe (Entity Qualification)) type LicenceTableData = DBRow (Entity UserAvs, Entity User, Maybe (Entity QualificationUser), Maybe (Entity Qualification))
@ -457,14 +457,14 @@ mkLicenceTable dbtIdent aLic apids = do
-- | otherwise -> E.isNothing (qual E.?. QualificationId) E.||. (E.val aLic E.=?. E.joinV (qual E.?. QualificationAvsLicence)) -- if we suggest granting that licence, this join should deliver a value too -- | otherwise -> E.isNothing (qual E.?. QualificationId) E.||. (E.val aLic E.=?. E.joinV (qual E.?. QualificationAvsLicence)) -- if we suggest granting that licence, this join should deliver a value too
fltrLic qual = E.isNothing (qual E.?. QualificationId) E.||. E.isJust (E.joinV $ qual E.?. QualificationAvsLicence) fltrLic qual = E.isNothing (qual E.?. QualificationId) E.||. E.isJust (E.joinV $ qual E.?. QualificationAvsLicence)
-- TODO: user holding multiple qualifications may appear multiple times in to-delete-in-avs table, which is kinda ugly. Solution: -- TODO: user holding multiple qualifications may appear multiple times in to-delete-in-avs table, which is kinda ugly. Solution:
dbtSQLQuery = \((usrAvs `E.InnerJoin` user) `E.LeftOuterJoin` (qualUser `E.InnerJoin` qual)) -> do dbtSQLQuery = \(usrAvs `E.InnerJoin` user `E.LeftOuterJoin` qualUser `E.LeftOuterJoin` qual) -> do
E.on $ qual E.?. QualificationId E.==. qualUser E.?. QualificationUserQualification E.on $ qual E.?. QualificationId E.==. qualUser E.?. QualificationUserQualification
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? 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?
-- Not sure what changes here: -- Not sure what changes here:
-- dbtProj = dbtProjId -- Simple $ \(userAvs, user, qualUsr, quali) -> return (userAvs, user, qualUsr, quali) -- dbtProj = dbtProjId -- Simple $ \(userAvs, user, qualUsr, quali) -> return (userAvs, user, qualUsr, quali)
dbtProj = dbtProjFilteredPostId dbtProj = dbtProjFilteredPostId
@ -519,6 +519,7 @@ mkLicenceTable dbtIdent aLic apids = do
, prismAForm (singletonFilter "validity" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgFilterLmsValid) , prismAForm (singletonFilter "validity" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgFilterLmsValid)
, prismAForm (singletonFilter "user-company") mPrev $ aopt textField (fslI MsgTableCompany) , prismAForm (singletonFilter "user-company") mPrev $ aopt textField (fslI MsgTableCompany)
] ]
qualOpt :: Entity Qualification -> Handler (Option QualificationId) qualOpt :: Entity Qualification -> Handler (Option QualificationId)
qualOpt (Entity qualId qual) = do qualOpt (Entity qualId qual) = do
cQualId :: CryptoUUIDQualification <- encrypt qualId cQualId :: CryptoUUIDQualification <- encrypt qualId

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

@ -4,12 +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> <section>
<h1> <h1>
HINWEIS HINWEIS
<p> <p>
Momentan werden aus Effizienzgründen alle Tabellen beschnitten und abgekürzt. 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. Auch die Funktion zum Import unbekannter Führerscheininhaber ist derzeit auf ein paar Hundert beschränkt.
<section> <section>
<h2> <h2>