chore(avs): add timeout to cardno filter

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

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

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]) -> 
+      , single ("avs-card"  , FilterColumnHandler $ \case
-          case criteria of 
+          [] -> return (const E.true) :: Handler (QualificationTableExpr -> E.SqlExpr (E.Value Bool))
-            [] -> return (const E.true) :: Handler (QualificationTableExpr -> E.SqlExpr (E.Value Bool))
+          cs -> 
-            xs -> do
+            let crds = mapMaybe parseAvsCardNo $ foldMap anySeparatedText cs
-              let crds = mapMaybe parseAvsCardNo $ foldMap anySeparatedText xs
+            in  timeoutHandler (0 * 30 * 1000000) (queryAvsCardNos crds) >>= \case 
-              apids <- queryAvsCardNos crds
+              Nothing               -> addMessageI Error MsgAvsCommunicationTimeout 
-              if null apids
+                                    >> return (const E.false)
-                then                   
+              (Just (null -> True)) -> return (const E.false)
-                  return (const E.false)
+              (Just apids) -> return $ 
-                else 
+                \(queryUser -> user) ->
-                  return $ \(queryUser-> user) ->
+                  E.exists $ E.from $ \usrAvs ->
-                    E.exists $ E.from $ \usrAvs ->
+                    E.where_ $ usrAvs E.^. UserAvsUser E.==. user E.^. UserId
-                      E.where_ $ usrAvs E.^. UserAvsUser E.==. user E.^. UserId
+                        E.&&.  usrAvs E.^. UserAvsPersonId `E.in_` E.vals apids
-                          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

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 :: Text -> [Text]
-anySeparatedText = Set.fromList . mapMaybe (assertM' (not . Text.null) . Text.strip) . Text.split anySeparator
+anySeparatedText = mapMaybe (assertM' (not . Text.null) . Text.strip) . Text.split anySeparator
   where anySeparator :: Char -> Bool
         anySeparator c = Char.isSeparator c || c == ',' || c == ';'