fraport/fradrive
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
-- 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
<dt .deflist__dt>Filter "#{reason}" (#{Set.size multiFirmBlocks}):
<dd .deflist__dd>#{showApids multiFirmBlocks}
<dt .deflist__dt>Filtered "#{reason}" (#{Set.size reasonFltrdIds}):
<dd .deflist__dd>#{showApids reasonFltrdIds}
|]
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.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

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

@ -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