Merge branch 'fradrive/jost' into 'master'

AVS automatic synchronisation

See merge request fradrive/fradrive!37

messages/uniworx/categories/admin/de-de-formal.msg

@@ -121,6 +121,7 @@ ProblemsNoAvsIdBody: Fahrer mit gültiger Fahrberechtigung in FRADrive, welche t
 ProblemsAvsSynchHeading: Synchronisation AVS Fahrberechtigungen
 ProblemsAvsErrorHeading: Fehlermeldungen
 ProblemsInterfaceSince: Berücksichtigt werden nur Erfolge und Fehler seit 
+ProblemAvsUsrHadR: Momentan gültiges R im AVS
 
 AdminProblemSolved: Erledigt
 AdminProblemSolver: Bearbeitet von

messages/uniworx/categories/admin/en-eu.msg

@@ -120,7 +120,8 @@ ProblemsNoAvsIdHeading: Drivers without AVS id
 ProblemsNoAvsIdBody: Drivers having a valid apron driving licence within FRADrive only, but who may not drive since a missing AVS id prevents communication of the driving licence to AVS:
 ProblemsAvsSynchHeading: Synchronisation AVS Driving Licences
 ProblemsAvsErrorHeading: Error Log
-ProblemsInterfaceSince: Only considering successes and errors since 
+ProblemsInterfaceSince: Only considering successes and errors since
+ProblemAvsUsrHadR: Currenlt R valid in AVS
 
 AdminProblemSolved: Done
 AdminProblemSolver: Solved by

src/Database/Esqueleto/Utils.hs

@@ -15,6 +15,7 @@ module Database.Esqueleto.Utils
   , (=?.), (?=.)
   , (=~.), (~=.)
   , (>~.), (<~.)
+  , (~.), (~*.), (!~.), (!~*.)
   , or, and
   , any, all
   , not__, parens
@@ -26,6 +27,7 @@ module Database.Esqueleto.Utils
   , mkContainsFilterWithSet, mkContainsFilterWithComma, mkContainsFilterWithCommaPlus
   , mkDayFilter, mkDayFilterFrom, mkDayFilterTo
   , mkExistsFilter, mkExistsFilterWithComma
+  --  , mkRegExFilterWith
   , anyFilter, allFilter
   , ascNullsFirst, descNullsLast
   , orderByList
@@ -163,6 +165,24 @@ infixl 4 <~.
 (<~.) ::  PersistField typ => E.SqlExpr (E.Value typ) -> E.SqlExpr (E.Value (Maybe typ)) -> E.SqlExpr (E.Value Bool)
 (<~.) a b = E.isNothing b E.||. (E.just a E.<. b)
 
+infixr 2 ~., ~*., !~., !~*.
+
+-- | PostgreSQL regular expression match, case sensitive. Works, but may throw SQL error for unblanced parenthesis, etc. Not suitable for dbTable filters
+(~.) :: E.SqlString s => E.SqlExpr (E.Value s) -> E.SqlExpr (E.Value s) -> E.SqlExpr (E.Value Bool)
+(~.) = E.unsafeSqlBinOp    " ~ "
+
+-- | PostgreSQL regular expression match, case insensitive. Works, but may throw SQL errors
+(~*.) :: E.SqlString s => E.SqlExpr (E.Value s) -> E.SqlExpr (E.Value s) -> E.SqlExpr (E.Value Bool)
+(~*.) = E.unsafeSqlBinOp    " ~* "
+
+-- | PostgreSQL regular expression does not match, case sensitive. Works, but may throw SQL error for unblanced parenthesis, etc. Not suitable for dbTable filters
+(!~.) :: E.SqlString s => E.SqlExpr (E.Value s) -> E.SqlExpr (E.Value s) -> E.SqlExpr (E.Value Bool)
+(!~.) = E.unsafeSqlBinOp    " !~ "
+
+-- | PostgreSQL regular expression does not match, case insensitive. Works, but may throw SQL errors
+(!~*.) :: E.SqlString s => E.SqlExpr (E.Value s) -> E.SqlExpr (E.Value s) -> E.SqlExpr (E.Value Bool)
+(!~*.) = E.unsafeSqlBinOp    " !~* "
+
 
 -- | Negation of `isNothing` which is missing
 isJust :: PersistField typ => E.SqlExpr (E.Value (Maybe typ)) -> E.SqlExpr (E.Value Bool)
@@ -415,6 +435,18 @@ mkContainsFilterWithCommaPlus cast lenslike row (foldMap commaSeparatedText -> c
     cond_compulsory = all (hasInfix (lenslike row) . E.val . cast) compulsories
     cond_optional   = any (hasInfix (lenslike row) . E.val . cast) alternatives
 
+-- like `mkContainsFilterWith` but allows regular expression criterias
+-- This works, but throws SQL errors for unbalanced parenthesis and similar invalid regex expressions
+-- mkRegExFilterWith :: (E.SqlString b, Ord a)
+--                      => (a -> b)
+--                      -> (t -> E.SqlExpr (E.Value b))  -- ^ getter from query to searched element
+--                      -> t                             -- ^ query row
+--                      -> Set.Set a                     -- ^ needle collection
+--                      -> E.SqlExpr (E.Value Bool)
+-- mkRegExFilterWith cast lenslike row criterias
+--   | Set.null criterias = true
+--   | otherwise = any ((~.) (lenslike row) . E.val . cast) criterias
+
 mkDayFilter :: (t -> E.SqlExpr (E.Value UTCTime))  -- ^ getter from query to searched element
             -> t                                   -- ^ query row
             -> Last Day                            -- ^ a day to filter for

src/Foundation/Type.hs

@@ -15,7 +15,7 @@ module Foundation.Type
   , _memcachedLocalARC
   , SMTPPool
   , _appSettings', _appStatic, _appConnPool, _appSmtpPool, _appLdapPool, _appWidgetMemcached, _appHttpManager, _appLogger, _appLogSettings, _appCryptoIDKey, _appClusterID, _appInstanceID, _appJobState, _appSessionStore, _appSecretBoxKey, _appJSONWebKeySet, _appHealthReport, _appMemcached, _appUploadCache, _appVerpSecret, _appAuthKey, _appPersonalisedSheetFilesSeedKey, _appVolatileClusterSettingsCache, _appAvsQuery
-  , DB, Form, MsgRenderer, MailM, DBFile
+  , DB, DBRead, Form, MsgRenderer, MailM, DBFile
   ) where
 
 import Import.NoFoundation
@@ -123,8 +123,9 @@ instance HasCookieSettings RegisteredCookie UniWorX where
 instance (MonadHandler m, HandlerSite m ~ UniWorX) => ReadLogSettings m where
   readLogSettings = liftIO . readTVarIO =<< getsYesod (view _appLogSettings)
 
-  
+
 type DB = YesodDB UniWorX
+type DBRead = ReaderT SqlReadBackend (HandlerFor UniWorX)
 type Form x = Html -> MForm (HandlerFor UniWorX) (FormResult x, WidgetFor UniWorX ())
 type MsgRenderer = MsgRendererS UniWorX -- see Utils
 type MailM a = MailT (HandlerFor UniWorX) a

src/Handler/Admin.hs

@@ -93,7 +93,7 @@ handleAdminProblems mbProblemTable = do
   diffLics <- try retrieveDifferingLicences >>= \case
     -- (Left (UnsupportedContentType "text/html" resp)) -> Left $ text2widget "Html received"
     (Left e) -> return $ Left $ text2widget $ tshow (e :: SomeException)
-    (Right AvsLicenceDifferences{..}) -> do
+    (Right (AvsLicenceDifferences{..},_)) -> do
       let problemIds = avsLicenceDiffRevokeAll <> avsLicenceDiffGrantVorfeld <> avsLicenceDiffRevokeRollfeld <> avsLicenceDiffGrantRollfeld
       void $ runDB $ queueAvsUpdateByAID problemIds $ Just nowaday
       return $ Right
@@ -104,7 +104,7 @@ handleAdminProblems mbProblemTable = do
         )
   -- Attempt to format results in a nicer way failed, since rendering Html within a modal destroyed the page layout itself
   -- let procDiffLics (to0, to1, to2) = Right (Set.size to0, Set.size to1, Set.size to2)
-  -- diffLics <- (procDiffLics <$> retrieveDifferingLicences) `catches`
+  -- diffLics <- (procDiffLics . fst <$> retrieveDifferingLicences) `catches`
   --   [ Catch.Handler (\case (UnsupportedContentType "text/html;charset=utf-8" Response{responseBody})
   --                                         -> return $ Left $ toWidget $ preEscapedToHtml $ fromRight "Response UTF8-decoding error" $ LBS.decodeUtf8' responseBody
   --                          ex             -> return $ Left $ text2widget $ tshow ex)

src/Handler/Admin/Avs.hs

@@ -378,8 +378,8 @@ postProblemAvsSynchR = getProblemAvsSynchR
 getProblemAvsSynchR = do
   let catchAllAvs' r = flip catch (\err -> addMessageModal Error (i18n MsgAvsCommunicationError) (Right (text2widget $ tshow (err :: SomeException))) >> redirect r)
       catchAllAvs    = catchAllAvs' ProblemAvsSynchR -- == current route; use only in conditions that are not repeated upon reload; do not call redirect within catchAllAvs actions!
-  (AvsLicenceDifferences{..}, apidStatus) <- catchAllAvs' AdminR retrieveDifferingLicencesStatus
+  ((AvsLicenceDifferences{..}, rsChanged), apidStatus) <- catchAllAvs' AdminR retrieveDifferingLicencesStatus
-
+  let mkLicTbl = mkLicenceTable apidStatus rsChanged
   --
   unknownLicenceOwners' <- whenNonEmpty avsLicenceDiffRevokeAll $ \neZeros ->
     runDB $ E.select $ do
@@ -434,10 +434,10 @@ getProblemAvsSynchR = do
 
   -- licence differences
   ((tres0,tb0),(tres1up,tb1up),(tres1down,tb1down),(tres2,tb2)) <- runDB $ (,,,)
-          <$> mkLicenceTable apidStatus "avsLicDiffRevokeVorfeld"  AvsLicenceVorfeld   avsLicenceDiffRevokeAll
+          <$> mkLicTbl "avsLicDiffRevokeVorfeld"  AvsLicenceVorfeld   avsLicenceDiffRevokeAll
-          <*> mkLicenceTable apidStatus "avsLicDiffGrantVorfeld"   AvsNoLicence        avsLicenceDiffGrantVorfeld
+          <*> mkLicTbl "avsLicDiffGrantVorfeld"   AvsNoLicence        avsLicenceDiffGrantVorfeld
-          <*> mkLicenceTable apidStatus "avsLicDiffRevokeRollfeld" AvsLicenceRollfeld  avsLicenceDiffRevokeRollfeld
+          <*> mkLicTbl "avsLicDiffRevokeRollfeld" AvsLicenceRollfeld  avsLicenceDiffRevokeRollfeld -- downgrade to Vorfeld
-          <*> mkLicenceTable apidStatus "avsLicDiffGrantRollfeld"  AvsNoLicence        avsLicenceDiffGrantRollfeld
+          <*> mkLicTbl "avsLicDiffGrantRollfeld"  AvsNoLicence        avsLicenceDiffGrantRollfeld
 
   now <- liftIO getCurrentTime
   let procRes :: AvsLicence -> (LicenceTableActionData, Set AvsPersonId) -> Handler ()
@@ -476,6 +476,7 @@ getProblemAvsSynchR = do
   formResult tres1up    $ procRes AvsLicenceVorfeld
   formResult tres0      $ procRes AvsNoLicence
 
+  AvsLicenceSynchConf{..} <- getsYesod $ view _appAvsLicenceSynchConf
   siteLayoutMsg MsgAvsTitleLicenceSynch $ do
     setTitleI   MsgAvsTitleLicenceSynch
     $(i18nWidgetFile "avs-synchronisation")
@@ -528,9 +529,11 @@ instance HasUser LicenceTableData where
 -- instance HasQualificationUser LicenceTableData where -- Not possible, since not all rows have a QualificationUser
 --   hasQualificationUser = resultQualUser . _entityVal
 
-mkLicenceTable :: AvsPersonIdMapPersonCard -> Text -> AvsLicence -> Set AvsPersonId -> DB (FormResult (LicenceTableActionData, Set AvsPersonId), Widget)
+mkLicenceTable :: AvsPersonIdMapPersonCard -> Set AvsPersonId -> Text -> AvsLicence -> Set AvsPersonId -> DB (FormResult (LicenceTableActionData, Set AvsPersonId), Widget)
-mkLicenceTable apidStatus dbtIdent aLic apids = do
+mkLicenceTable apidStatus rsChanged dbtIdent aLic apids = do
-  currentRoute <- fromMaybe (error "mkLicenceTable called from 404-handler") <$> liftHandler getCurrentRoute
+  (currentRoute, usrHasAvsRerr) <- liftHandler $ (,)
+    <$> (fromMaybe (error "mkLicenceTable called from 404-handler") <$> liftHandler getCurrentRoute)
+    <*> (messageTooltip <$> messageI Error MsgProblemAvsUsrHadR)
   avsQualifications <- selectList [QualificationAvsLicence !=. Nothing] [Asc QualificationName]
   now <- liftIO getCurrentTime
 
@@ -571,7 +574,18 @@ mkLicenceTable apidStatus dbtIdent aLic apids = do
                   (\(E.Value cmpSh, E.Value cmpName, E.Value cmpSpr) -> simpleLink (citext2widget cmpName) (FirmUsersR cmpSh) <> bool mempty icnSuper cmpSpr) <$> companies'
 
             pure $ intercalate (text2widget "; ") companies
-        , sortable (Just "qualification") (i18nCell MsgTableQualifications)          $ \(preview   resultQualification -> q) -> cellMaybe lmsShortCell q
+        , sortable (Just "qualification") (i18nCell MsgTableQualifications) $
+            if aLic /= AvsLicenceVorfeld
+              then
+                \(preview   resultQualification -> q) -> cellMaybe lmsShortCell q
+              else
+                \row ->
+                  let q       = row ^? resultQualification
+                      apid    = row ^. resultUserAvs . _userAvsPersonId
+                      warnCell c = if Set.member apid rsChanged
+                        then c <> spacerCell <> wgtCell usrHasAvsRerr    -- expected to be effectively dead code in practice, but we never know
+                        else c
+                  in warnCell $ cellMaybe lmsShortCell q
         , sortable (Just "first-held")    (i18nCell MsgTableQualificationFirstHeld)  $ \(preview $ resultQualUser . _entityVal . _qualificationUserFirstHeld   -> d)  -> cellMaybe dayCell d
         , sortable (Just "last-refresh")  (i18nCell MsgTableQualificationLastRefresh)$ \(preview $ resultQualUser . _entityVal . _qualificationUserLastRefresh -> d)  -> cellMaybe dayCell d
         -- , sortable (Just "valid-until")   (i18nCell MsgLmsQualificationValidUntil)   $ \(preview $ resultQualUser . _entityVal . _qualificationUserValidUntil  -> d)  -> cellMaybe dayCell d

src/Handler/MailCenter.hs

@@ -107,12 +107,14 @@ mkMCTable = do
     dbtFilter = mconcat
       [ single ("sent"      , FilterColumn . E.mkDayFilterTo                        $ views (to queryMail)        (E.^. SentMailSentAt))
       , single ("recipient" , FilterColumn . E.mkContainsFilterWithCommaPlus Just   $ views (to queryRecipient)   (E.?. UserDisplayName))
-      , single ("subject"   , FilterColumn . E.mkContainsFilter                     $ views (to queryMail)        (E.str2text . (E.^. SentMailHeaders)))
+      , single ("subject"   , FilterColumn . E.mkContainsFilterWithCommaPlus id     $ views (to queryMail)        (E.str2text . (E.^. SentMailHeaders)))
+      -- , single ("regex"     , FilterColumn . E.mkRegExFilterWith id                 $ views (to queryMail)        (E.str2text . (E.^. SentMailHeaders)))
       ]
     dbtFilterUI mPrev = mconcat
       [ prismAForm (singletonFilter "sent"      . maybePrism _PathPiece) mPrev $ aopt (hoistField lift  dayField)  (fslI MsgPrintJobCreated)
       , prismAForm (singletonFilter "recipient" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField)  (fslI MsgPrintRecipient & setTooltip MsgTableFilterCommaPlus)
       , prismAForm (singletonFilter "subject"   . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField)  (fslI MsgCommSubject    & setTooltip MsgTableFilterCommaPlusShort)
+      -- , prismAForm (singletonFilter "regex"     . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField)  (fslI MsgCommSubject    )
       ]
     dbtStyle = def { dbsFilterLayout = defaultDBSFilterLayout}
     dbtIdent :: Text

src/Handler/Utils/Avs.hs

@@ -22,7 +22,7 @@ module Handler.Utils.Avs
   , computeDifferingLicences
   -- , synchAvsLicences
   , queryAvsFullStatus
-  -- , lookupAvsUser, lookupAvsUsers
+  , lookupAvsUser, lookupAvsUsers
   , AvsException(..)
   , updateReceivers
   , AvsPersonIdMapPersonCard
@@ -903,30 +903,32 @@ avsLicenceDifferences2personLicences AvsLicenceDifferences{..} =
   <> Set.map (AvsPersonLicence AvsLicenceRollfeld) avsLicenceDiffGrantRollfeld
 
 computeDifferingLicences :: AvsResponseGetLicences -> Handler (Set AvsPersonLicence)
-computeDifferingLicences = fmap avsLicenceDifferences2personLicences . getDifferingLicences
+computeDifferingLicences = fmap (avsLicenceDifferences2personLicences . fst) . getDifferingLicences
 
 type AvsPersonIdMapPersonCard = Map AvsPersonId (Set AvsDataPersonCard)
 
 avsResponseStatusMap :: AvsResponseStatus -> AvsPersonIdMapPersonCard
 avsResponseStatusMap (AvsResponseStatus status) = Map.fromDistinctAscList [(avsStatusPersonID,avsStatusPersonCardStatus) | AvsStatusPerson{..}<- Set.toAscList status]
 
-retrieveDifferingLicences :: Handler AvsLicenceDifferences
+retrieveDifferingLicences :: Handler (AvsLicenceDifferences, Set AvsPersonId)
 retrieveDifferingLicences = fst <$> retrieveDifferingLicences' False
 
-retrieveDifferingLicencesStatus :: Handler (AvsLicenceDifferences, AvsPersonIdMapPersonCard)
+retrieveDifferingLicencesStatus :: Handler ((AvsLicenceDifferences, Set AvsPersonId), AvsPersonIdMapPersonCard)
 retrieveDifferingLicencesStatus = retrieveDifferingLicences' True
 
-retrieveDifferingLicences' :: Bool -> Handler (AvsLicenceDifferences, AvsPersonIdMapPersonCard)
+retrieveDifferingLicences' :: Bool -> Handler ((AvsLicenceDifferences, Set AvsPersonId),  AvsPersonIdMapPersonCard)
 retrieveDifferingLicences' getStatus = do
 #ifdef DEVELOPMENT
-  avsUsrs <- runDB $ selectList [] [LimitTo 444]
+  avsUsrs <- runDBRead $ selectList [] [LimitTo 444]
   let allLicences = 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]
+        ] ++ [AvsPersonLicence (bool AvsLicenceRollfeld AvsLicenceVorfeld $ even $ avsPersonId avsid) avsid
+             | Entity _ UserAvs{userAvsPersonId = avsid} <- avsUsrs
+             ]
 #else
   allLicences  <- avsQueryNoCache AvsQueryGetAllLicences
 #endif
@@ -942,7 +944,7 @@ retrieveDifferingLicences' getStatus = do
               ] <>
               [ AvsStatusPerson  avsid $ Set.singleton $ mkAdpc (even $ avsPersonId avsid) AvsCardColorGelb | Entity _ UserAvs{userAvsPersonId = avsid} <- avsUsrs ]
 #else
-  let statQry = avsLicenceDifferences2LicenceIds lDiff
+  let statQry = avsLicenceDifferences2LicenceIds $ fst lDiff
   lStat <- if getStatus && notNull statQry
             then avsQueryNoCache (AvsQueryStatus statQry)
               -- `catch` handler
@@ -954,7 +956,7 @@ retrieveDifferingLicences' getStatus = do
   return (lDiff, avsResponseStatusMap lStat)
 
 
-getDifferingLicences :: AvsResponseGetLicences -> Handler AvsLicenceDifferences
+getDifferingLicences :: AvsResponseGetLicences -> Handler (AvsLicenceDifferences, Set AvsPersonId)
 getDifferingLicences (AvsResponseGetLicences licences) = do
   now <- liftIO getCurrentTime
   --let (vorfeld, nonvorfeld) = Set.partition (`avsPersonLicenceIs` AvsLicenceVorfeld)  licences
@@ -965,7 +967,7 @@ getDifferingLicences (AvsResponseGetLicences licences) = do
       vorORrollfeld  = Set.map avsLicencePersonID vorORrollfeld'
       rollfeld       = Set.map avsLicencePersonID rollfeld'
 
-      antijoinAvsLicences :: AvsLicence -> Set AvsPersonId -> DB (Set AvsPersonId,Set AvsPersonId)
+      antijoinAvsLicences :: AvsLicence -> Set AvsPersonId -> DBRead (Set AvsPersonId,Set AvsPersonId)
       antijoinAvsLicences lic avsLics = fmap unwrapIds $
        E.select $ do
         ((_qauli :& _qualUser :& usrAvs) :& excl) <-
@@ -991,19 +993,21 @@ getDifferingLicences (AvsResponseGetLicences licences) = do
           aux (E.Value(Just api), _) (l,r) = (Set.insert api l, r)
           aux _ acc = acc -- should never occur
 
-  ((vorfGrant, vorfRevoke), (rollGrant, rollRevoke)) <- runDB $ (,)
+  ((vorfGrant, vorfRevoke), (rollGrant, rollRevoke)) <- runDBRead $ (,)
     <$> antijoinAvsLicences AvsLicenceVorfeld  vorORrollfeld
     <*> antijoinAvsLicences AvsLicenceRollfeld rollfeld
   let setTo0      = vorfRevoke                    -- revoke driving licences
       setTo1up    = vorfGrant  Set.\\ rollGrant   -- grant apron driving licence
       setTo1down  = rollRevoke Set.\\ vorfRevoke  -- revoke maneuvering area licence, but retain apron driving licence
       setTo2      = (rollGrant Set.\\ vorfRevoke) `Set.intersection` (vorfGrant `Set.union` vorORrollfeld) -- grant maneuvering driving licence
-  return AvsLicenceDifferences
+      rsChanged   = rollfeld `Set.intersection` Set.unions [vorfRevoke, rollRevoke, setTo1up] -- maneuvering driving licences to downgrade in AVS
-    { avsLicenceDiffRevokeAll      = setTo0
+      alds = AvsLicenceDifferences
-    , avsLicenceDiffGrantVorfeld   = setTo1up
+              { avsLicenceDiffRevokeAll      = setTo0
-    , avsLicenceDiffRevokeRollfeld = setTo1down
+              , avsLicenceDiffGrantVorfeld   = setTo1up
-    , avsLicenceDiffGrantRollfeld  = setTo2
+              , avsLicenceDiffRevokeRollfeld = setTo1down
-    }
+              , avsLicenceDiffGrantRollfeld  = setTo2
+              }
+  return (alds, rsChanged)
     {- Cases to consider (AVS_Licence,has_valid_F, has_valid_R) -> (vorfeld@(toset,unset), rollfeld@(toset,unset)) :
         A (0,0,0)  -> ((_,_),(_,_)) : nop; avs_id not returned from queries, no problem
         B (0,0,1)  -> ((_,_),(x,_)) : nop; do nothing     -- CHECK since id is returned by roll-query

src/Handler/Utils/Communication.hs

@@ -15,7 +15,7 @@ module Handler.Utils.Communication
 
 import Import
 import Handler.Utils
-import Handler.Utils.Users 
+import Handler.Utils.Users
 
 import Jobs.Queue
 
@@ -124,7 +124,7 @@ crJobsFirmCommunication jCompanies Communication{..} = do
       adrReceiverMails = Set.map (Address Nothing . CI.original) rawReceiverMails
   netReceiverAddresses <- lift $ do
     netReceiverIds <- getReceiversFor $ jSender : Set.toList rawReceiverIds -- ensure supervisors get only one email
-    maybeMapM getEmailAddressFor netReceiverIds    
+    maybeMapM getEmailAddressFor netReceiverIds
   -- let jAllRecipientAddresses = Set.fromList netReceiverAddresses <> adrReceiverMails
   let jAllRecipientAddresses = Set.map getAddress (Set.fromList (AddressEqIgnoreName <$> netReceiverAddresses) <> Set.map AddressEqIgnoreName adrReceiverMails)
   forM_ jAllRecipientAddresses $ \raddr ->
@@ -145,7 +145,7 @@ commR CommunicationRoute{..} =  do
       decrypt' cID = do
         uid <- decrypt cID
         whenIsJust crRecipientAuth $ guardAuthResult <=< ($ uid)
-        getEntity uid  
+        getEntity uid
   cUser <- maybeAuth
   (chosenRecipients, suggestedRecipients) <- runDB $ (,)
     <$> (maybe id cons cUser . catMaybes <$> (mapM decrypt' =<< lookupGlobalGetParams GetRecipient))
@@ -155,7 +155,7 @@ commR CommunicationRoute{..} =  do
   MsgRenderer mr <- getMsgRenderer
   mbCurrentRoute <- getCurrentRoute
   globalCC <- getsYesod $ view _appCommunicationGlobalCC
-  
+
   let
     lookupUser :: UserId -> (UserDisplayName,UserSurname)
     lookupUser =
@@ -163,7 +163,7 @@ commR CommunicationRoute{..} =  do
           usrNames Nothing = ("???","???") -- this case only happens during runFormPost when POST Data is present and no form is display
           usrNames (Just User{userDisplayName, userSurname}) = (userDisplayName, userSurname)
       in usrNames . flip Map.lookup usrMap
-  
+
     chosenRecipients' = Map.fromList $
       [ ( (BoundedPosition $ RecipientGroup g, pos)
         , (Right recp, recp `elem` map entityKey chosenRecipients)
@@ -174,9 +174,9 @@ commR CommunicationRoute{..} =  do
       [ ( (BoundedPosition   RecipientCustom, pos)
         , (recp, True)
         )
-      | (pos, recp) <- zip [0..] 
+      | (pos, recp) <- zip [0..]
           ( mcons (Left <$> globalCC)
-            (Right <$> Set.toList (Set.fromList (map entityKey chosenRecipients) \\ Set.fromList (concatMap (map entityKey) $ view _2 <$> suggestedRecipients)))
+            (Right <$> Set.toList (Set.fromList (map entityKey chosenRecipients) \\ Set.fromList (concatMap (map entityKey . view _2) suggestedRecipients)))
           )
       ]
     activeCategories = map RecipientGroup (view _1 <$> suggestedRecipients) `snoc` RecipientCustom
@@ -243,7 +243,7 @@ commR CommunicationRoute{..} =  do
         postProcess = Set.fromList . map fst . filter snd . Map.elems
 
   recipientsListMsg <- messageI Info MsgCommRecipientsList
-  
+
   attachmentsMaxSize <- getsYesod $ view _appCommunicationAttachmentsMaxSize
   let attachmentField = genericFileField $ return FileField
         { fieldIdent = Nothing
@@ -261,9 +261,9 @@ commR CommunicationRoute{..} =  do
     <*> ( CommunicationContent
             <$> aopt textField (fslI MsgCommSubject & addAttr "uw-enter-as-tab" "") Nothing
             <*> (markupOutput <$> areq htmlField (fslI MsgCommBody) Nothing)
-            <*> fmap fold (aopt (convertFieldM (runConduit . (.| C.foldMap Set.singleton)) yieldMany attachmentField) 
+            <*> fmap fold (aopt (convertFieldM (runConduit . (.| C.foldMap Set.singleton)) yieldMany attachmentField)
                               (fslI MsgCommAttachments & setTooltip MsgCommAttachmentsTip) Nothing)
-        )    
+        )
   formResult commRes $ \case
     (comm, BtnCommunicationSend) -> do
       runDBJobs . runConduit $ transPipe (mapReaderT lift) (crJobs comm) .| sinkDBJobs
@@ -272,13 +272,13 @@ commR CommunicationRoute{..} =  do
     (comm, BtnCommunicationTest) -> do
       runDBJobs . runConduit $ transPipe (mapReaderT lift) (crTestJobs comm) .| sinkDBJobs
       addMessageI Info MsgCommTestSuccess
-  
+
   let formWdgt = wrapForm commWdgt def
         { formMethod   = POST
         , formAction   = SomeRoute <$> mbCurrentRoute
         , formEncoding = commEncoding
         , formSubmit   = FormNoSubmit
-        }  
+        }
   siteLayoutMsg crHeading $ do
     setTitleI crTitle
     let commTestTip = $(i18nWidgetFile "comm-test-tip")

src/Handler/Utils/Qualification.hs

@@ -58,7 +58,7 @@ quserToNotify cutoff quser qblock = -- either recently become invalid with no pr
           E.&&. qblock E.?. QualificationUserBlockFrom E.>. E.just (quser E.^. QualificationUserLastNotified)
         ))
 
--- condition to ensure that the lastest QualificationUserBlock was picked, better to be used in join-on clauses, since inside a where-clause it might not work as intended
+-- | condition to ensure that the lastest QualificationUserBlock was picked, better to be used in join-on clauses, since inside a where-clause it might not work as intended
 isLatestBlockBefore :: E.SqlExpr (Maybe (Entity QualificationUserBlock)) -> E.SqlExpr (E.Value UTCTime) -> E.SqlExpr (E.Value Bool)
 isLatestBlockBefore qualBlock cutoff = (cutoff E.>~. qualBlock E.?. QualificationUserBlockFrom) E.&&. E.notExists (do
     newerBlock <- E.from $ E.table @QualificationUserBlock
@@ -71,6 +71,20 @@ isLatestBlockBefore qualBlock cutoff = (cutoff E.>~. qualBlock E.?. Qualificatio
                ))
   )
 
+-- | condition to ensure that the lastest QualificationUserBlock was picked, better to be used in join-on clauses, since inside a where-clause it might not work as intended
+--   variant for inner joins
+isLatestBlockBefore' :: E.SqlExpr (Entity QualificationUserBlock) -> E.SqlExpr (E.Value UTCTime) -> E.SqlExpr (E.Value Bool)
+isLatestBlockBefore' qualBlock cutoff = (cutoff E.>. qualBlock E.^. QualificationUserBlockFrom) E.&&. E.notExists (do
+    newerBlock <- E.from $ E.table @QualificationUserBlock
+    E.where_ $          newerBlock E.^. QualificationUserBlockQualificationUser E.==. qualBlock E.^. QualificationUserBlockQualificationUser
+        E.&&.           newerBlock E.^. QualificationUserBlockFrom              E.<=. cutoff
+        E.&&.           newerBlock E.^. QualificationUserBlockId                E.!=. qualBlock E.^. QualificationUserBlockId
+        E.&&.  ((       newerBlock E.^. QualificationUserBlockFrom              E.>.  qualBlock E.^. QualificationUserBlockFrom)
+          E.||. (       newerBlock E.^. QualificationUserBlockUnblock           -- in case of equal timestamps, any unblock wins
+                 E.&&. (newerBlock E.^. QualificationUserBlockFrom              E.==. qualBlock E.^. QualificationUserBlockFrom)
+               ))
+  )
+
 -- cutoff can be `E.val now` or even `Database.Esqueleto.PostgreSQL.now_`
 quserBlockAux :: Bool -> E.SqlExpr (E.Value UTCTime) -> (E.SqlExpr (E.Value QualificationUserId) -> E.SqlExpr (E.Value Bool)) -> Maybe (E.SqlExpr (Entity QualificationUserBlock) -> E.SqlExpr (E.Value Bool)) -> E.SqlExpr (E.Value Bool)
 quserBlockAux negCond cutoff checkQualUserId mbBlockCondition = bool E.notExists E.exists negCond $ do

src/Jobs/Crontab.hs

@@ -110,7 +110,7 @@ determineCrontab = execWriterT $ do
     sheetJobs (Entity nSheet Sheet{..}) = do
       for_ (max <$> sheetVisibleFrom <*> sheetActiveFrom) $ \aFrom -> do
         tellPrewarmJobs (JobCtlPrewarmSheetFile nSheet SheetExercise) aFrom
-        
+
         when (isn't _JobsOffload appJobMode) $ do
           tell $ HashMap.singleton
             (JobCtlQueue $ JobQueueNotification NotificationSheetActive{..})
@@ -181,7 +181,7 @@ determineCrontab = execWriterT $ do
 
   runConduit $ transPipe lift (selectSource [] []) .| C.mapM_ sheetJobs
 
-  
+
   when (isn't _JobsOffload appJobMode) $ do
     case appJobFlushInterval of
       Just interval | maybe True (> 0) appJobMaxFlush -> tell $ HashMap.singleton
@@ -396,28 +396,41 @@ determineCrontab = execWriterT $ do
     whenIsJust appJobLmsQualificationsEnqueueHour $ \hour -> tell $ HashMap.singleton
       (JobCtlQueue JobLmsQualificationsEnqueue)
       Cron
-        { cronInitial   = CronAsap  -- time after scheduling 
+        { cronInitial   = CronAsap  -- time after scheduling
         , cronRepeat    = CronRepeatScheduled $ cronCalendarAny { cronDayOfWeek = CronMatchSome . impureNonNull . Set.fromList $ [1..5]
-                                                                , cronHour   = cronMatchOne hour -- cronHour = CronMatchSome (impureNonNull $ Set.fromList [3,15] ) 
+                                                                , cronHour   = cronMatchOne hour -- cronHour = CronMatchSome (impureNonNull $ Set.fromList [3,15] )
                                                                 , cronMinute = cronMatchOne 2
                                                                 , cronSecond = cronMatchOne 27
                                                                 }
         , cronRateLimit = 600        -- minimal time between two executions, before the second job is skipped
         , cronNotAfter  = Right CronNotScheduled       -- maximal delay of an execution, before it is skipped entirely
-        }      
+        }
 
     whenIsJust appJobLmsQualificationsDequeueHour $ \hour -> tell $ HashMap.singleton
       (JobCtlQueue JobLmsQualificationsDequeue)
       Cron
-        { cronInitial   = CronAsap  -- time after scheduling 
+        { cronInitial   = CronAsap  -- time after scheduling
         , cronRepeat    = CronRepeatScheduled $ cronCalendarAny { cronDayOfWeek = CronMatchSome . impureNonNull . Set.fromList $ [1..5]
-                                                                , cronHour   = cronMatchOne hour -- cronHour = CronMatchSome (impureNonNull $ Set.fromList [3,15] ) 
+                                                                , cronHour   = cronMatchOne hour -- cronHour = CronMatchSome (impureNonNull $ Set.fromList [3,15] )
                                                                 , cronMinute = cronMatchOne 7
                                                                 , cronSecond = cronMatchOne 27
                                                                 }
         , cronRateLimit = 600        -- minimal time between two executions, before the second job is skipped
         , cronNotAfter  = Right CronNotScheduled       -- maximal delay of an execution, before it is skipped entirely
-        }   
+        }
+
+    when (notNull (avsLicenceSynchTimes appAvsLicenceSynchConf)) $ tell $ HashMap.singleton
+      (JobCtlQueue JobSynchroniseAvsLicences)
+      Cron
+        { cronInitial = CronAsap
+        , cronRateLimit = 10                          -- minimal time between two executions, before the second job is skipped
+        , cronNotAfter  = Right CronNotScheduled      -- maximal delay of an execution, before it is skipped entirely
+        , cronRepeat    = CronRepeatScheduled $ cronCalendarAny { cronDayOfWeek = CronMatchSome . impureNonNull . Set.fromList $ [1..5] --weekdays only
+                                                                , cronHour      = CronMatchSome . impureNonNull . Set.fromList $ avsLicenceSynchTimes appAvsLicenceSynchConf
+                                                                , cronMinute    = cronMatchOne 1
+                                                                , cronSecond    = cronMatchOne 3
+                                                                }
+        }
 
     let
       correctorNotifications :: Map (UserId, SheetId) (Max UTCTime) -> WriterT (Crontab JobCtl) (ReaderT SqlReadBackend (HandlerFor UniWorX)) ()
@@ -455,7 +468,7 @@ determineCrontab = execWriterT $ do
             ExamPart{examPartExam} <- MaybeT . $cachedHereBinary epId $ get epId
             Exam{..} <- MaybeT . $cachedHereBinary examPartExam $ get examPartExam
             return examFinished
-          notifyTime <- hoistMaybe . nBot $ maybe NTop (max `on` NTop) examFinishedTime submissionRatingTime 
+          notifyTime <- hoistMaybe . nBot $ maybe NTop (max `on` NTop) examFinishedTime submissionRatingTime
           tell $ HashMap.singleton
             (JobCtlQueue . JobQueueNotification $ NotificationSubmissionRated subId)
             Cron

src/Jobs/Handler/SynchroniseAvs.hs

@@ -7,11 +7,14 @@ module Jobs.Handler.SynchroniseAvs
   -- , dispatchJobSynchroniseAvsId
   -- , dispatchJobSynchroniseAvsUser
   , dispatchJobSynchroniseAvsQueue
+  , dispatchJobSynchroniseAvsLicences
   ) where
 
 import Import
 
+import qualified Data.Text            as Text
 import qualified Data.Set             as Set
+import qualified Data.Map             as Map
 import qualified Data.Conduit.List as C
 
 import           Database.Esqueleto.Experimental ((:&)(..))
@@ -23,6 +26,7 @@ import qualified Database.Esqueleto.Utils as E
 import Jobs.Queue
 
 import Handler.Utils.Avs
+import Handler.Utils.Qualification
 
 -- pause is a date in the past; don't synch again if the last synch was after pause
 dispatchJobSynchroniseAvs :: Natural -> Natural -> Natural -> Maybe Day -> JobHandler UniWorX
@@ -128,3 +132,59 @@ dispatchJobSynchroniseAvsQueue = JobHandlerException $ do
     discernJob accs (         _ , E.Value (Just api), E.Value True  ) = accs & over _2 (Set.insert api)
     discernJob accs (E.Value uid, E.Value  Nothing  , E.Value True  ) = accs & over _1 (Set.insert uid)
     discernJob accs (         _ ,                 _ , E.Value False ) = accs
+
+
+-----------------
+-- AVS Licences
+
+dispatchJobSynchroniseAvsLicences :: JobHandler UniWorX
+-- dispatchJobSynchroniseAvsLicences = error "TODO"
+dispatchJobSynchroniseAvsLicences = JobHandlerException $ do -- when (synchLevel > 0) $ do
+  AvsLicenceSynchConf
+    { avsLicenceSynchLevel        = synchLevel   -- SynchLevel corresponds to tables of ProblemAvsSynchR: 4=top grant R, 3= reduce R->F, 2= grant F, 1= revoke F
+    , avsLicenceSynchReasonFilter = reasonFilter
+    , avsLicenceSynchMaxChanges   = maxChanges
+    } <- getsYesod $ view _appAvsLicenceSynchConf
+
+  let -- TODO: enable a cron job by setting
+      procLic :: AvsLicence -> Bool -> Set AvsPersonId -> Handler ()
+      procLic aLic up apids
+        | n <- Set.size apids, n > 0 =
+          let subtype = Text.cons (bool '↧' '↥' up) $ Text.singleton $ licence2char aLic
+              logit errm = runDB $ logInterface' "AVS" subtype False (isJust errm) (Just n) (fromMaybe "Automatic synch" errm)
+              catchAllAvs = flip catch (\err -> logit (Just $ tshow (err :: SomeException)) >> return (-1))
+          in if NTop (Just n) <= NTop maxChanges
+              then do
+                oks <- catchAllAvs $ setLicencesAvs $ Set.map (AvsPersonLicence aLic) apids
+                when (oks > 0) $ logit $ toMaybe (oks /= n) [st|Only #{tshow oks}/#{tshow n} licence changes accepted by AVS|]
+              else
+                logit $ Just [st|Too many changes at once. Consider increasing avs-licence-synch-max-changes #{tshow maxChanges}|]
+        | otherwise = return ()
+
+  (AvsLicenceDifferences{..}, rsChanged) <- retrieveDifferingLicences
+  -- prevent automatic changes to users blocked with certain reasons and with currently being associated with multiple companies
+  multiFirmBlocks <- ifNothingM reasonFilter mempty $ \reasons -> do
+    now <- liftIO getCurrentTime
+    firmBlocks <- runDBRead $ E.select $ do
+      (uavs :& _qualUser :& qblock) <- E.from $ E.table @UserAvs
+        `E.innerJoin` E.table @QualificationUser      `E.on` (\(uavs :& qualUser) -> uavs E.^. UserAvsUser E.==. qualUser E.^. QualificationUserUser)
+        `E.innerJoin` E.table @QualificationUserBlock `E.on` (\(_uavs :& qualUser :& qblock) ->
+            qualUser E.^. QualificationUserId E.==. qblock E.^. QualificationUserBlockQualificationUser
+            E.&&. qblock `isLatestBlockBefore'` E.val now)
+      E.where_ $ (qblock E.^. QualificationUserBlockReason E.~*. E.val reasons)
+          E.&&.  uavs E.^. UserAvsPersonId `E.in_` E.vals (avsLicenceDiffRevokeAll `Set.union` avsLicenceDiffRevokeRollfeld)
+          E.&&. E.not_ (qblock E.^. QualificationUserBlockUnblock)
+      return $ uavs E.^. UserAvsPersonId
+    firmBlockData <- lookupAvsUsers $ Set.fromList $ map E.unValue firmBlocks                      -- may throw, but we need to abort then
+    return $ Map.keysSet $ Map.filter hasMultipleFirms firmBlockData
+
+  let fltrIds
+        | synchLevel >= 5 = id
+        | synchLevel >= 3 = flip Set.difference   multiFirmBlocks
+        | otherwise       = flip Set.difference $ multiFirmBlocks `Set.union` rsChanged
+
+  when (synchLevel >= 1) $ procLic AvsNoLicence       False $ fltrIds avsLicenceDiffRevokeAll        --revoke    Vorfeld and maybe also Rollfeld
+  when (synchLevel >= 2) $ procLic AvsLicenceVorfeld  True  $ fltrIds avsLicenceDiffGrantVorfeld     --grant     Vorfeld
+  when (synchLevel >= 3) $ procLic AvsLicenceVorfeld  False $ fltrIds avsLicenceDiffRevokeRollfeld   --downgrade Rollfeld -> Vorfeld
+  when (synchLevel >= 4) $ procLic AvsLicenceRollfeld True  $ fltrIds avsLicenceDiffGrantRollfeld    --grant     Rollfeld
+

src/Jobs/Types.hs

@@ -109,6 +109,7 @@ data Job
   --                             , jSynchAfter :: Maybe Day
   --                             }
   | JobSynchroniseAvsQueue
+  | JobSynchroniseAvsLicences
   | JobChangeUserDisplayEmail { jUser :: UserId
                               , jDisplayEmail :: UserEmail
                               }

src/Model/Types/Avs.hs

@@ -501,6 +501,10 @@ deriveJSON defaultOptions
   } ''AvsDataPerson
 -}
 
+hasMultipleFirms :: AvsDataPerson -> Bool
+hasMultipleFirms AvsDataPerson{avsPersonPersonCards=crds} =
+  1 < Set.size (Set.filter isJust $ Set.map avsDataFirm crds)
+
 data AvsPersonLicence = AvsPersonLicence
       { avsLicenceRampLicence  :: AvsLicence
       , avsLicencePersonID     :: AvsPersonId

src/Settings.hs

@@ -102,6 +102,8 @@ data AppSettings = AppSettings
     -- ^ Configuration settings for accessing the LDAP-directory
     , appAvsConf                :: Maybe AvsConf
     -- ^ Configuration settings for accessing AVS Server (= Ausweis Verwaltungs System)
+    , appAvsLicenceSynchConf    :: AvsLicenceSynchConf
+    -- ^ Configuration settings for automatically synching driving licences with AVS
     , appLprConf                :: LprConf
     -- ^ Configuration settings for accessing a printer queue via lpr for letter mailing
     , appSmtpConf               :: Maybe SmtpConf
@@ -248,11 +250,11 @@ data AppSettings = AppSettings
 
     , appCommunicationAttachmentsMaxSize :: Maybe Natural
     , appCommunicationGlobalCC :: Maybe UserEmail
-    
+
     , appFileChunkingParams     :: FastCDCParameters
 
     , appLegalExternal          :: Set LegalExternal
-    
+
     } deriving Show
 
 
@@ -335,6 +337,21 @@ data AvsConf = AvsConf
   , avsCacheExpiry  :: DiffTime -- Seconds, only for non-licence related queries
   } deriving (Show)
 
+data AvsLicenceSynchConf = AvsLicenceSynchConf
+  { avsLicenceSynchTimes        :: [Natural]    -- hours, when a synch should occur
+  , avsLicenceSynchLevel        :: Int          -- 0: No synch, 1: revoke Vorfeld, 2: Grant Vorfeld, 3: Downgrade to Vorfeld, 4: Grant Rollfeld
+  , avsLicenceSynchReasonFilter :: Maybe Text   -- regular expression matched case-insensitive against latest block/grant reason, preventing automatic synch to users with this reason AND being associated with multiple companies
+  , avsLicenceSynchMaxChanges   :: Maybe Int    -- abort synch for group, if there are too many changes overall
+  } deriving (Show)
+
+instance Default AvsLicenceSynchConf where
+  def = AvsLicenceSynchConf
+        { avsLicenceSynchTimes        = []
+        , avsLicenceSynchLevel        = 0
+        , avsLicenceSynchReasonFilter = Nothing
+        , avsLicenceSynchMaxChanges   = Nothing
+        }
+
 data LprConf = LprConf
   { lprHost :: String
   , lprPort :: Int
@@ -423,11 +440,11 @@ data SettingBotMitigation
   deriving anyclass (Universe, Finite)
 
 data LegalExternal = LegalExternal
-  { externalLanguage :: Lang 
+  { externalLanguage :: Lang
   , externalImprint :: Text
   , externalDataProtection :: Text
   , externalTermsOfUse :: Text
-  , externalPayments :: Text    
+  , externalPayments :: Text
   }
   deriving (Eq, Ord, Read, Show, Generic)
 makeLenses_ ''LegalExternal
@@ -523,7 +540,7 @@ instance FromJSON LmsConf where
     lmsUploadHeader       <- o .:  "upload-header"
     lmsUploadDelimiter    <- o .:? "upload-delimiter"
     lmsDownloadHeader     <- o .:  "download-header"
-    lmsDownloadDelimiter  <- o .:  "download-delimiter"    
+    lmsDownloadDelimiter  <- o .:  "download-delimiter"
     lmsDownloadCrLf       <- o .:  "download-cr-lf"
     lmsDeletionDays       <- o .:  "deletion-days"
     return LmsConf{..}
@@ -540,7 +557,17 @@ instance FromJSON AvsConf where
     avsCacheExpiry  <- o .: "cache-expiry"
     return AvsConf{..}
 
-makeLenses_ ''AvsConf    
+makeLenses_ ''AvsConf
+
+instance FromJSON AvsLicenceSynchConf where
+  parseJSON = withObject "AvsLicenceSynch" $ \o -> do
+    avsLicenceSynchTimes        <- o .:  "times"
+    avsLicenceSynchLevel        <- o .:  "level"
+    avsLicenceSynchReasonFilter <- o .:? "reason-filter"
+    avsLicenceSynchMaxChanges   <- o .:? "max-changes"
+    return AvsLicenceSynchConf{..}
+
+makeLenses_ ''AvsLicenceSynchConf
 
 instance FromJSON LprConf where
   parseJSON = withObject "LprConf" $ \o -> do
@@ -611,7 +638,7 @@ instance FromJSON ServerSessionSettings where
       , ServerSession.setPersistentCookies <$> persistentCookies
       ])
 
-instance FromJSON LegalExternal where 
+instance FromJSON LegalExternal where
   parseJSON = withObject "LegalExternal" $ \o -> do
     externalLanguage <- o .: "language"
     externalImprint <- o .: "imprint"
@@ -640,6 +667,7 @@ instance FromJSON AppSettings where
         appLdapConf               <- P.fromList . mapMaybe (assertM nonEmptyHost) <$> o .:? "ldap" .!= []
         appLmsConf                <- o .: "lms-direct"
         appAvsConf                <- assertM (not . null . avsPass)  <$> o .:? "avs"
+        appAvsLicenceSynchConf    <- o .:? "avs-licence-synch" .!= def
         appLprConf                <- o .: "lpr"
         appSmtpConf               <- assertM (not . null . smtpHost) <$> o .:? "smtp"
         let validMemcachedConf MemcachedConf{memcachedConnectInfo = Memcached.ConnectInfo{..}} = and

templates/i18n/avs-synchronisation/de-de-formal.hamlet

@@ -35,7 +35,7 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
   <p>
     ^{tb2}
   <h3>
-    Fahrbrechtigung Rollfeld ungültig in FRADrive, aber im AVS vorhanden
+    Fahrbrechtigung Rollfeld ungültig in FRADrive, aber im AVS vorhanden und Fahrberechtigung Vorfeld gültig in FRADrive
   <p>
     ^{tb1down}
   <h3>
@@ -43,7 +43,41 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
   <p>
     ^{tb1up}
   <h3>
-    Keine gültige Fahrberechtigung in FRADrive, aber im AVS vorhanden
+    Keine gültige Fahrberechtigung in FRADrive, aber im AVS vorhanden (Roll- oder Vorfeld)
   <p>
     ^{tb0}
-    
+    
+$if notNull avsLicenceSynchTimes
+  <section>
+    <h2>
+      Automatische AVS Fahrlizen Sychronisation
+    <p>
+      <dl .deflist>
+        <dt .deflist__dt>
+          Uhrzeiten Synchronisation
+        <dd .deflist__dd>
+          Werktags, weniger Minuten nach folgenden vollen Stunden: #{tshow avsLicenceSynchTimes}
+        <dt .deflist__dt>
+          Synchronisationslevel
+        <dd .deflist__dd>
+          #{avsLicenceSynchLevel} #
+            $case avsLicenceSynchLevel
+              $of 1
+                Nur Vorfeld-Fahrberechtigungen entziehen
+              $of 2 
+                Vorfeld-Fahrberechtigungen entziehen und gewähren
+              $of 3
+                Vorfeld-Fahrberechtigungen entziehen und gewähren, #
+                so wie Rollfeld-Fahrberechtigungen zu Vorfeld-Fahrberechtigungen herabstufen
+              $of _
+                Vorfeld- und Rollfeld-Fahrberechtigungen entziehen und gewähren
+        $maybe reasons <- avsLicenceSynchReasonFilter
+          <dt .deflist__dt>
+            Ausnahmen
+          <dd .deflist__dd>
+            Keine automatische Synchronisation, wenn die Begründung des letzten Un-/Blocks zu diesen regulären Ausdruck passt: #{reasons}
+        $maybe maxChange <- avsLicenceSynchMaxChanges
+          <dt .deflist__dt>
+            Maximal Änderungen
+          <dd .deflist__dd>
+            Keine Synchronisation durchführen, wenn es mehr als #{maxChange} Änderungen pro Level wären

templates/i18n/avs-synchronisation/en-eu.hamlet

@@ -35,7 +35,7 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
   <p>
     ^{tb2}
   <h3>
-    Maneuvering area driving licence 'R' invalid in FRADrive, but valid in AVS
+    Maneuvering area driving licence 'R' invalid in FRADrive, but valid in AVS and having a valid 'F' in FRADrive
   <p>
     ^{tb1down}
   <h3>
@@ -43,6 +43,40 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
   <p>
     ^{tb1up}
   <h3>
-    No valid driving licence in FRADrive, but having a driving licence in AVS
+    No valid driving licence in FRADrive, but having any driving licence in AVS (maneuvering or apron)
   <p>
     ^{tb0}
+
+$if notNull avsLicenceSynchTimes
+  <section>
+    <h2>
+      Automatic AVS licence sychronisation
+    <p>
+      <dl .deflist>
+        <dt .deflist__dt>
+          Synchronisation times
+        <dd .deflist__dd>
+          Synchronize on weekdays, few minutes after each full hour: #{tshow avsLicenceSynchTimes}
+        <dt .deflist__dt>
+          Synchronisation level
+        <dd .deflist__dd>
+          #{avsLicenceSynchLevel} #
+            $case avsLicenceSynchLevel
+              $of 1
+                Revoke apron driving licences only
+              $of 2 
+                Grant and revoke apron driving licences only
+              $of 3
+                Grant and revoke apron driving licences and downgrade maneuvering area licences to apron driving licences
+              $of _
+                Grant and revoke all driving licences automatically
+        $maybe reasons <- avsLicenceSynchReasonFilter
+          <dt .deflist__dt>
+            Exemptions
+          <dd .deflist__dd>
+            Do not synchronize changes where the last un-/block reason matches #{reasons}
+        $maybe maxChange <- avsLicenceSynchMaxChanges
+          <dt .deflist__dt>
+            Max changes
+          <dd .deflist__dd>
+            Do not synchronize a licence if the number of changes exceeds #{maxChange}