diff --git a/messages/uniworx/categories/avs/de-de-formal.msg b/messages/uniworx/categories/avs/de-de-formal.msg index bd5c01716..fd3b39fa8 100644 --- a/messages/uniworx/categories/avs/de-de-formal.msg +++ b/messages/uniworx/categories/avs/de-de-formal.msg @@ -9,6 +9,7 @@ AvsFirstName: Vorname AvsLastName: Nachname AvsInternalPersonalNo: Personalnummer (nur Fraport AG) AvsVersionNo: Versionsnummer +AvsQueryNeeded: Benötigt Verbindung zum AVS. AvsQueryEmpty: Bitte mindestens ein Anfragefeld ausfüllen! AvsQueryStatusInvalid t@Text: Nur numerische IDs eingeben, durch Komma getrennt! Erhalten: #{show t} AvsLicence: Fahrberechtigung @@ -27,6 +28,7 @@ RevokeFraDriveLicences alic@AvsLicence n@Int: _{alic} in FRADrive entzogen für 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. +AvsCommunicationTimeout: AVS Schnittstelle antwortete nicht. LicenceTableChangeAvs: Im AVS ändern LicenceTableGrantFDrive: In FRADrive erteilen LicenceTableRevokeFDrive: In FRADrive entziehen diff --git a/messages/uniworx/categories/avs/en-eu.msg b/messages/uniworx/categories/avs/en-eu.msg index ec7288d7d..ccaeb9012 100644 --- a/messages/uniworx/categories/avs/en-eu.msg +++ b/messages/uniworx/categories/avs/en-eu.msg @@ -9,6 +9,7 @@ AvsFirstName: First name AvsLastName: Last name AvsInternalPersonalNo: Personnel number (Fraport AG only) AvsVersionNo: Version number +AvsQueryNeeded: AVS connection required. AvsQueryEmpty: At least one query field must be filled! AvsQueryStatusInvalid t: Numeric IDs only, comma seperated! #{show t} AvsLicence: Driving Licence @@ -27,6 +28,7 @@ RevokeFraDriveLicences alic@AvsLicence n@Int: _{alic} revoked in FRADrive for #{ 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. +AvsCommunicationTimeout: AVS interface returned no response within timeout limit. LicenceTableChangeAvs: Change in AVS LicenceTableGrantFDrive: Grant in FRADrive LicenceTableRevokeFDrive: Revoke in FRADrive diff --git a/src/Handler/Qualification.hs b/src/Handler/Qualification.hs index bb24e8102..67a7e4bd6 100644 --- a/src/Handler/Qualification.hs +++ b/src/Handler/Qualification.hs @@ -19,6 +19,7 @@ import Handler.Utils import Handler.Utils.Users import Handler.Utils.LMS import Handler.Utils.Avs (queryAvsCardNos) +import Handler.Utils.Concurrent import qualified Data.Set as Set import qualified Data.Map as Map @@ -417,20 +418,19 @@ mkQualificationTable isAdmin (Entity qid quali) acts cols psValidator = do -- E.where_ $ usrAvs E.^. UserAvsUser E.==. user E.^. UserId -- E.&&. (avsCard E.^. UserAvsCardCardNo E.==. E.val cardNo) -- ) - , single ("avs-card" , FilterColumnHandler $ \(criteria :: [Text]) -> - case criteria of - [] -> return (const E.true) :: Handler (QualificationTableExpr -> E.SqlExpr (E.Value Bool)) - xs -> do - let crds = mapMaybe parseAvsCardNo $ foldMap anySeparatedText xs - apids <- queryAvsCardNos crds - if null apids - then - return (const E.false) - else - return $ \(queryUser-> user) -> - E.exists $ E.from $ \usrAvs -> - E.where_ $ usrAvs E.^. UserAvsUser E.==. user E.^. UserId - E.&&. usrAvs E.^. UserAvsPersonId `E.in_` E.vals apids + , single ("avs-card" , FilterColumnHandler $ \case + [] -> return (const E.true) :: Handler (QualificationTableExpr -> E.SqlExpr (E.Value Bool)) + cs -> + let crds = mapMaybe parseAvsCardNo $ foldMap anySeparatedText cs + in timeoutHandler (0 * 30 * 1000000) (queryAvsCardNos crds) >>= \case + Nothing -> addMessageI Error MsgAvsCommunicationTimeout + >> return (const E.false) + (Just (null -> True)) -> return (const E.false) + (Just apids) -> return $ + \(queryUser -> user) -> + E.exists $ E.from $ \usrAvs -> + E.where_ $ usrAvs E.^. UserAvsUser E.==. user E.^. UserId + E.&&. usrAvs E.^. UserAvsPersonId `E.in_` E.vals apids ) , single ("personal-number", FilterColumn $ \(queryUser -> user) (criteria :: Set.Set Text) -> if | Set.null criteria -> E.true @@ -462,7 +462,7 @@ mkQualificationTable isAdmin (Entity qid quali) acts cols psValidator = do [ fltrUserNameEmailHdrUI MsgLmsUser mPrev , prismAForm (singletonFilter "user-company") mPrev $ aopt textField (fslI MsgTableCompany) , prismAForm (singletonFilter "personal-number" ) mPrev $ aopt textField (fslI MsgCompanyPersonalNumber) - , prismAForm (singletonFilter "avs-card" ) mPrev $ aopt textField (fslI MsgAvsCardNo & setTooltip MsgTableFilterComma) + , prismAForm (singletonFilter "avs-card" ) mPrev $ aopt textField (fslI MsgAvsCardNo & setTooltip SomeMessages [SomeMessage MsgTableFilterComma, SomeMessage MsgAvsQueryNeeded]) , prismAForm (singletonFilter "avs-number" ) mPrev $ aopt textField (fslI MsgAvsPersonNo) , prismAForm (singletonFilter "validity" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgFilterLmsValid) , if isNothing mbRenewal then mempty diff --git a/src/Utils.hs b/src/Utils.hs index f0440caa5..79a7bfd66 100644 --- a/src/Utils.hs +++ b/src/Utils.hs @@ -534,8 +534,8 @@ commaSeparatedText :: Text -> Set Text commaSeparatedText = Set.fromList . mapMaybe (assertM' (not . Text.null) . Text.strip) . Text.split (==',') -- also see Utils.Form.cfAnySeparatedSet -anySeparatedText :: Text -> Set Text -anySeparatedText = Set.fromList . mapMaybe (assertM' (not . Text.null) . Text.strip) . Text.split anySeparator +anySeparatedText :: Text -> [Text] +anySeparatedText = mapMaybe (assertM' (not . Text.null) . Text.strip) . Text.split anySeparator where anySeparator :: Char -> Bool anySeparator c = Char.isSeparator c || c == ',' || c == ';'