fraport/fradrive-old
Archived
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fix(avs): fix #124 avs auto synch filter working

Browse Source 
also, provide test facility for auto synch
This commit is contained in:
Steffen Jost 2024-09-05 16:27:10 +02:00
parent 620e3e4700
commit 2a27a1efa6
3 changed files with 16 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
src/Handler/Admin/Avs.hs
View File

@ -327,24 +327,23 @@ postAdminAvsR = do
(AvsLicenceDifferences{..}, rsChanged) <- retrieveDifferingLicences (AvsLicenceDifferences{..}, rsChanged) <- retrieveDifferingLicences
-- prevent automatic changes to users blocked with certain reasons and with currently being associated with multiple companies -- 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 now <- liftIO getCurrentTime
firmBlocks <- runDBRead $ E.select $ do firmBlocks <- runDBRead $ E.select $ do
(uavs :& _qualUser :& qblock) <- X.from $ E.table @UserAvs (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) -> `E.innerJoin` E.table @QualificationUserBlock `X.on` (\(_uavs :& qualUser :& qblock) ->
qualUser E.^. QualificationUserId E.==. qblock E.^. QualificationUserBlockQualificationUser qualUser E.^. QualificationUserId E.==. qblock E.^. QualificationUserBlockQualificationUser
E.&&. qblock `isLatestBlockBefore'` E.val now) E.&&. qblock `isLatestBlockBefore'` E.val now)
E.where_ $ (qblock E.^. QualificationUserBlockReason E.~*. E.val reasons) 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 return $ uavs E.^. UserAvsPersonId
firmBlockData <- lookupAvsUsers $ Set.fromList $ map E.unValue firmBlocks -- may throw, but we need to abort then return $ Set.fromList $ map E.unValue firmBlocks
return $ Map.keysSet $ Map.filter hasMultipleFirms firmBlockData
let fltrIds let fltrIds
| synchLevel >= 5 = id | synchLevel >= 5 = id
| synchLevel >= 3 = flip Set.difference multiFirmBlocks | synchLevel >= 3 = flip Set.difference reasonFltrdIds
| otherwise = flip Set.difference $ multiFirmBlocks `Set.union` rsChanged | otherwise = flip Set.difference $ reasonFltrdIds `Set.union` rsChanged
l1 = guardMonoid (synchLevel >= 1) $ procLic AvsNoLicence False $ fltrIds avsLicenceDiffRevokeAll --revoke Vorfeld and maybe also Rollfeld 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 l2 = guardMonoid (synchLevel >= 2) $ procLic AvsLicenceVorfeld True $ fltrIds avsLicenceDiffGrantVorfeld --grant Vorfeld
@ -359,8 +358,8 @@ postAdminAvsR = do
^{l2} ^{l2}
^{l1} ^{l1}
$maybe reason <- reasonFilter $maybe reason <- reasonFilter
<dt .deflist__dt>Filter "#{reason}" (#{Set.size multiFirmBlocks}): <dt .deflist__dt>Filtered "#{reason}" (#{Set.size reasonFltrdIds}):
<dd .deflist__dd>#{showApids multiFirmBlocks} <dd .deflist__dd>#{showApids reasonFltrdIds}
|] |]
return (basediffs, autoDiffs) return (basediffs, autoDiffs)

13
src/Jobs/Handler/SynchroniseAvs.hs
View File

@ -14,7 +14,7 @@ import Import
import qualified Data.Text as Text import qualified Data.Text as Text
import qualified Data.Set as Set 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 qualified Data.Conduit.List as C
import Database.Esqueleto.Experimental ((:&)(..)) import Database.Esqueleto.Experimental ((:&)(..))
@ -163,7 +163,7 @@ dispatchJobSynchroniseAvsLicences = JobHandlerException $ do -- when (synchLevel
(AvsLicenceDifferences{..}, rsChanged) <- retrieveDifferingLicences (AvsLicenceDifferences{..}, rsChanged) <- retrieveDifferingLicences
-- prevent automatic changes to users blocked with certain reasons and with currently being associated with multiple companies -- 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 now <- liftIO getCurrentTime
firmBlocks <- runDBRead $ E.select $ do firmBlocks <- runDBRead $ E.select $ do
(uavs :& _qualUser :& qblock) <- E.from $ E.table @UserAvs (uavs :& _qualUser :& qblock) <- E.from $ E.table @UserAvs
@ -172,15 +172,14 @@ dispatchJobSynchroniseAvsLicences = JobHandlerException $ do -- when (synchLevel
qualUser E.^. QualificationUserId E.==. qblock E.^. QualificationUserBlockQualificationUser qualUser E.^. QualificationUserId E.==. qblock E.^. QualificationUserBlockQualificationUser
E.&&. qblock `isLatestBlockBefore'` E.val now) E.&&. qblock `isLatestBlockBefore'` E.val now)
E.where_ $ (qblock E.^. QualificationUserBlockReason E.~*. E.val reasons) 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 return $ uavs E.^. UserAvsPersonId
firmBlockData <- lookupAvsUsers $ Set.fromList $ map E.unValue firmBlocks -- may throw, but we need to abort then return $ Set.fromList $ map E.unValue firmBlocks
return $ Map.keysSet $ Map.filter hasMultipleFirms firmBlockData
let fltrIds let fltrIds
| synchLevel >= 5 = id | synchLevel >= 5 = id
| synchLevel >= 3 = flip Set.difference multiFirmBlocks | synchLevel >= 3 = flip Set.difference reasonFltrdIds
| otherwise = flip Set.difference $ multiFirmBlocks `Set.union` rsChanged | otherwise = flip Set.difference $ reasonFltrdIds `Set.union` rsChanged
when (synchLevel >= 1) $ procLic AvsNoLicence False $ fltrIds avsLicenceDiffRevokeAll --revoke Vorfeld and maybe also Rollfeld 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 >= 2) $ procLic AvsLicenceVorfeld True $ fltrIds avsLicenceDiffGrantVorfeld --grant Vorfeld

2
src/Model/Types/Avs.hs
View File

@ -501,9 +501,11 @@ deriveJSON defaultOptions
} ''AvsDataPerson } ''AvsDataPerson
-} -}
{- Did not work as intended! Verify, if needed again.
hasMultipleFirms :: AvsDataPerson -> Bool hasMultipleFirms :: AvsDataPerson -> Bool
hasMultipleFirms AvsDataPerson{avsPersonPersonCards=crds} = hasMultipleFirms AvsDataPerson{avsPersonPersonCards=crds} =
1 < Set.size (Set.filter isJust $ Set.map avsDataFirm crds) 1 < Set.size (Set.filter isJust $ Set.map avsDataFirm crds)
-}
data AvsPersonLicence = AvsPersonLicence data AvsPersonLicence = AvsPersonLicence
{ avsLicenceRampLicence :: AvsLicence { avsLicenceRampLicence :: AvsLicence