From 2a27a1efa673a4245a7e8667bd30c79ac1891b9c Mon Sep 17 00:00:00 2001 From: Steffen Date: Thu, 5 Sep 2024 16:27:10 +0200 Subject: [PATCH] fix(avs): fix #124 avs auto synch filter working also, provide test facility for auto synch --- src/Handler/Admin/Avs.hs | 17 ++++++++--------- src/Jobs/Handler/SynchroniseAvs.hs | 13 ++++++------- src/Model/Types/Avs.hs | 2 ++ 3 files changed, 16 insertions(+), 16 deletions(-) diff --git a/src/Handler/Admin/Avs.hs b/src/Handler/Admin/Avs.hs index 83f74b159..916a6158d 100644 --- a/src/Handler/Admin/Avs.hs +++ b/src/Handler/Admin/Avs.hs @@ -327,24 +327,23 @@ postAdminAvsR = do (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 + reasonFltrdIds <- ifNothingM reasonFilter mempty $ \reasons -> do now <- liftIO getCurrentTime firmBlocks <- runDBRead $ E.select $ do (uavs :& _qualUser :& qblock) <- X.from $ E.table @UserAvs - `E.innerJoin` E.table @QualificationUser `X.on` (\(uavs :& qualUser) -> uavs E.^. UserAvsUser E.==. qualUser E.^. QualificationUserUser) + `E.innerJoin` E.table @QualificationUser `X.on` (\( uavs :& qualUser) -> uavs E.^. UserAvsUser E.==. qualUser E.^. QualificationUserUser) `E.innerJoin` E.table @QualificationUserBlock `X.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.&&. uavs E.^. UserAvsPersonId `E.in_` E.vals (Set.unions [avsLicenceDiffRevokeAll, avsLicenceDiffRevokeRollfeld, avsLicenceDiffGrantVorfeld, avsLicenceDiffGrantRollfeld]) 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 + return $ Set.fromList $ map E.unValue firmBlocks let fltrIds | synchLevel >= 5 = id - | synchLevel >= 3 = flip Set.difference multiFirmBlocks - | otherwise = flip Set.difference $ multiFirmBlocks `Set.union` rsChanged + | synchLevel >= 3 = flip Set.difference reasonFltrdIds + | otherwise = flip Set.difference $ reasonFltrdIds `Set.union` rsChanged l1 = guardMonoid (synchLevel >= 1) $ procLic AvsNoLicence False $ fltrIds avsLicenceDiffRevokeAll --revoke Vorfeld and maybe also Rollfeld l2 = guardMonoid (synchLevel >= 2) $ procLic AvsLicenceVorfeld True $ fltrIds avsLicenceDiffGrantVorfeld --grant Vorfeld @@ -359,8 +358,8 @@ postAdminAvsR = do ^{l2} ^{l1} $maybe reason <- reasonFilter -
Filter "#{reason}" (#{Set.size multiFirmBlocks}): -
#{showApids multiFirmBlocks} +
Filtered "#{reason}" (#{Set.size reasonFltrdIds}): +
#{showApids reasonFltrdIds} |] return (basediffs, autoDiffs) diff --git a/src/Jobs/Handler/SynchroniseAvs.hs b/src/Jobs/Handler/SynchroniseAvs.hs index 4748025b6..5651f9558 100644 --- a/src/Jobs/Handler/SynchroniseAvs.hs +++ b/src/Jobs/Handler/SynchroniseAvs.hs @@ -14,7 +14,7 @@ import Import import qualified Data.Text as Text import qualified Data.Set as Set -import qualified Data.Map as Map +-- import qualified Data.Map as Map import qualified Data.Conduit.List as C import Database.Esqueleto.Experimental ((:&)(..)) @@ -163,7 +163,7 @@ dispatchJobSynchroniseAvsLicences = JobHandlerException $ do -- when (synchLevel (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 + reasonFltrdIds <- ifNothingM reasonFilter mempty $ \reasons -> do now <- liftIO getCurrentTime firmBlocks <- runDBRead $ E.select $ do (uavs :& _qualUser :& qblock) <- E.from $ E.table @UserAvs @@ -172,15 +172,14 @@ dispatchJobSynchroniseAvsLicences = JobHandlerException $ do -- when (synchLevel 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.&&. uavs E.^. UserAvsPersonId `E.in_` E.vals (Set.unions [avsLicenceDiffRevokeAll, avsLicenceDiffRevokeRollfeld, avsLicenceDiffGrantVorfeld, avsLicenceDiffGrantRollfeld]) 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 + return $ Set.fromList $ map E.unValue firmBlocks let fltrIds | synchLevel >= 5 = id - | synchLevel >= 3 = flip Set.difference multiFirmBlocks - | otherwise = flip Set.difference $ multiFirmBlocks `Set.union` rsChanged + | synchLevel >= 3 = flip Set.difference reasonFltrdIds + | otherwise = flip Set.difference $ reasonFltrdIds `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 diff --git a/src/Model/Types/Avs.hs b/src/Model/Types/Avs.hs index 0c50360be..26c0aad49 100644 --- a/src/Model/Types/Avs.hs +++ b/src/Model/Types/Avs.hs @@ -501,9 +501,11 @@ deriveJSON defaultOptions } ''AvsDataPerson -} +{- Did not work as intended! Verify, if needed again. hasMultipleFirms :: AvsDataPerson -> Bool hasMultipleFirms AvsDataPerson{avsPersonPersonCards=crds} = 1 < Set.size (Set.filter isJust $ Set.map avsDataFirm crds) +-} data AvsPersonLicence = AvsPersonLicence { avsLicenceRampLicence :: AvsLicence