chore(avs): avs problem resolution revoke fradrives licences implemented

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.

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.

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