diff --git a/src/Handler/Admin/Avs.hs b/src/Handler/Admin/Avs.hs index 4ed23e15a..7a76d5fd0 100644 --- a/src/Handler/Admin/Avs.hs +++ b/src/Handler/Admin/Avs.hs @@ -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) diff --git a/src/Handler/Utils/Avs.hs b/src/Handler/Utils/Avs.hs index 7a7f25084..ad5d3ed63 100644 --- a/src/Handler/Utils/Avs.hs +++ b/src/Handler/Utils/Avs.hs @@ -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 diff --git a/templates/i18n/avs-synchronisation/de-de-formal.hamlet b/templates/i18n/avs-synchronisation/de-de-formal.hamlet index 4370ef23f..c29be3a1f 100644 --- a/templates/i18n/avs-synchronisation/de-de-formal.hamlet +++ b/templates/i18n/avs-synchronisation/de-de-formal.hamlet @@ -4,6 +4,12 @@ $# SPDX-FileCopyrightText: 2022 Steffen Jost $# $# SPDX-License-Identifier: AGPL-3.0-or-later + +

+ HINWEIS +

+ 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.

diff --git a/test/Database/Fill.hs b/test/Database/Fill.hs index 5c43956b5..fa753bc40 100644 --- a/test/Database/Fill.hs +++ b/test/Database/Fill.hs @@ -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