diff --git a/messages/uniworx/categories/avs/de-de-formal.msg b/messages/uniworx/categories/avs/de-de-formal.msg index 5dc27dbf8..5b89691d0 100644 --- a/messages/uniworx/categories/avs/de-de-formal.msg +++ b/messages/uniworx/categories/avs/de-de-formal.msg @@ -18,6 +18,7 @@ BtnRevokeAvsLicences: Fahrberechtigungen im AVS sofort entziehen BtnImportUnknownAvsIds: Daten unbekannter Personen importieren AvsImportIDs n@Int m@Int: AVS Persondendaten importiert: #{show n}/#{show m} AvsSetLicences alic@AvsLicence n@Int m@Int: _{alic} im AVS gesetzt: #{show n}/#{show m} +RevokeFraDriveLicences alic@AvsLicence n@Int: _{alic} in FRADrive zum Vortag beendet für #{show n} Fahrer RevokeUnknownLicencesOk: AVS Fahrberechtigungen unbekannter Fahrer wurden gesperrt RevokeUnknownLicencesFail: Nicht alle AVS Fahrberechtigungen unbekannter Fahrer konnten entzogen werden, siehe Log für Details AvsCommunicationError: AVS Schnittstelle lieferte einen unerwarteten Fehler. diff --git a/messages/uniworx/categories/avs/en-eu.msg b/messages/uniworx/categories/avs/en-eu.msg index c43316ceb..6d089edc1 100644 --- a/messages/uniworx/categories/avs/en-eu.msg +++ b/messages/uniworx/categories/avs/en-eu.msg @@ -18,6 +18,7 @@ BtnRevokeAvsLicences: Revoke AVS driving licences immediately BtnImportUnknownAvsIds: Import unknown person data AvsImportIDs n m: AVS person data imported: #{show n}/#{show m} AvsSetLicences alic n m: _{alic} set in AVS: #{show n}/#{show m} +RevokeFraDriveLicences alic@AvsLicence n@Int: _{alic} now ended yesterday in FRADrive for #{show n} drivers RevokeUnknownLicencesOk: AVS driving licences of unknown drivers revoked RevokeUnknownLicencesFail: Not all AVS driving licences of unknown drivers could be revoked, see log for details AvsCommunicationError: AVS interface returned an unexpected error. diff --git a/src/Handler/Admin/Avs.hs b/src/Handler/Admin/Avs.hs index a9c8f3fc4..169700aa0 100644 --- a/src/Handler/Admin/Avs.hs +++ b/src/Handler/Admin/Avs.hs @@ -19,6 +19,7 @@ import qualified Data.Text as Text import qualified Data.CaseInsensitive as CI import qualified Data.Set as Set import qualified Data.Map as Map +import Database.Persist.Sql (updateWhereCount) import Handler.Utils import Handler.Utils.Avs @@ -306,7 +307,7 @@ postProblemAvsSynchR, getProblemAvsSynchR :: Handler Html postProblemAvsSynchR = getProblemAvsSynchR getProblemAvsSynchR = do now <- liftIO getCurrentTime - let _nowaday = utctDay now + let nowaday = utctDay now -- TODO: just for Testing -- let TimeOfDay hours minutes _seconds = timeToTimeOfDay (utctDayTime now) @@ -361,8 +362,30 @@ getProblemAvsSynchR = do in addMessageI mkind $ MsgAvsSetLicences aLic no_ok no_req (Left err) -> addMessageModal Error (i18n MsgAvsCommunicationError) (Right (text2widget $ tshow (err :: SomeException))) redirect ProblemAvsSynchR -- reload to update all tables - -- procRes alic (LicenceTableRevokeFDriveData, apids) = do -- TODO: continue here !!! - -- qId <- runDB $ getBy UniqueQualificationAvsLicence alic + procRes alic (LicenceTableRevokeFDriveData, apids) = do + runDB $ do + qId <- getKeyBy404 $ UniqueQualificationAvsLicence $ Just alic + uas <- selectList [UserAvsPersonId <-. Set.toList apids] [] + let uids = view _userAvsUser <$> uas + endday = pred nowaday + crits = [QualificationUserQualification ==. qId, QualificationUserUser <-. uids] + oks <- fromIntegral <$> updateWhereCount crits [QualificationUserValidUntil =. endday, QualificationUserLastRefresh =. nowaday] + qus <- selectList crits [] + forM_ qus $ \qu -> + audit TransactionQualificationUserEdit + { transactionQualificationUser = qu ^. _entityKey + , transactionQualification = qId -- qu ^. _qualificationUserQualification + , transactionUser = qu ^. _qualificationUserUser + , transactionQualificationValidUntil = endday -- qu ^. _qualificationUserValidUntil + } + if oks /= length qus || oks /= Set.size apids + then do + $logErrorS "AVS" $ "Revoke FRADrive licences discrepancy! Requested: " <> tshow (Set.size apids) <> " Updated: " <> tshow oks <> " Found: " <> tshow (length qus) + liftHandler $ addMessageI Error $ MsgRevokeFraDriveLicences alic oks + else + liftHandler $ addMessageI Success $ MsgRevokeFraDriveLicences alic oks + redirect ProblemAvsSynchR -- must be outside runDB + -- procRes alic (LicenceTableGrantFDriveData{..}, apids ) = do -- TODO: continue here !!! procRes _alic r@(_, _apids) = addMessage Error $ toHtml $ "NOT YET IMPLEMENTED !!! " <> tshow r formResult tres2 $ procRes AvsLicenceRollfeld