diff --git a/src/Handler/Admin/Avs.hs b/src/Handler/Admin/Avs.hs index c3bf0c3f7..83f74b159 100644 --- a/src/Handler/Admin/Avs.hs +++ b/src/Handler/Admin/Avs.hs @@ -266,33 +266,104 @@ postAdminAvsR = do (qryLicForm, qryLicRes) <- runButtonForm FIDAvsQueryLicenceDiffs - mbQryLic <- case qryLicRes of - Nothing -> return Nothing + (mbQryLic :: Maybe Widget, mbAutoDiffs :: Maybe Html) <- case qryLicRes of + Nothing -> return mempty (Just BtnCheckLicences) -> do res <- try $ do allLicences <- avsQueryNoCache AvsQueryGetAllLicences computeDifferingLicences allLicences - case res of + basediffs <- case res of (Right diffs) -> do - let showLics l = Text.intercalate ", " $ fmap (tshow . avsLicencePersonID) $ Set.toList $ Set.filter ((l ==) . avsLicenceRampLicence) diffs - r_grant = showLics AvsLicenceRollfeld - f_set = showLics AvsLicenceVorfeld - revoke = showLics AvsNoLicence + let showLics l = + let chgs = Set.filter ((l ==) . avsLicenceRampLicence) diffs + in if Set.null chgs + then ("[ ]", 0) + else (Text.intercalate ", " (tshow . avsLicencePersonID <$> Set.toList chgs), Set.size chgs) + (r_grant, rg_size) = showLics AvsLicenceRollfeld + (f_set , fs_size) = showLics AvsLicenceVorfeld + (revoke , rv_size) = showLics AvsNoLicence return $ Just [whamlet|

Licence check differences: -

Grant R: -

- #{r_grant} -

Set to F: -

- #{f_set} -

Revoke licence: -

- #{revoke} +

+
Grant R (#{rg_size}): +
#{r_grant} + +
Set to F (#{fs_size}): +
#{f_set} + +
Revoke licence (#{rv_size}): +
#{revoke} |] (Left e) -> do let msg = tshow (e :: SomeException) return $ Just [whamlet|

Licence check error:

#{msg}|] + autoDiffs <- do + -- what follows is copy of the code from Jobs.Handler.SynchroniseAvs.dispatchJobSynchroniseAvsLicences modified to not do anything actually + 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 + guardMonoidM (synchLevel > 0) $ do + let showApids apids + | null apids = "[ ]" + | otherwise = Text.intercalate ", " (tshow <$> Set.toList apids) + procLic :: AvsLicence -> Bool -> Set AvsPersonId -> Html + procLic aLic up apids + | n <- Set.size apids, n > 0 = + let subtype = Text.cons (bool '↧' '↥' up) $ Text.singleton $ licence2char aLic + in if NTop (Just n) <= NTop maxChanges + then + [shamlet| +
#{subtype} (#{n}): +
#{showApids apids} + |] + else + [shamlet| +
#{subtype} (#{n}): +
Too many changes at once. Consider increasing avs-licence-synch-max-changes #{tshow maxChanges} + |] + | otherwise = mempty + + (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) <- 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 @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) + 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 + + 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 + l3 = guardMonoid (synchLevel >= 3) $ procLic AvsLicenceVorfeld False $ fltrIds avsLicenceDiffRevokeRollfeld --downgrade Rollfeld -> Vorfeld + l4 = guardMonoid (synchLevel >= 4) $ procLic AvsLicenceRollfeld True $ fltrIds avsLicenceDiffGrantRollfeld --grant Rollfeld + return $ Just [shamlet| +

+ Next automatic AVS licence synchronisation: +
+ ^{l4} + ^{l3} + ^{l2} + ^{l1} + $maybe reason <- reasonFilter +
Filter "#{reason}" (#{Set.size multiFirmBlocks}): +
#{showApids multiFirmBlocks} + |] + return (basediffs, autoDiffs) + -- (Just BtnSynchLicences) -> do -- res <- try synchAvsLicences -- case res of diff --git a/src/Jobs/Handler/SynchroniseAvs.hs b/src/Jobs/Handler/SynchroniseAvs.hs index c0a0596a0..4748025b6 100644 --- a/src/Jobs/Handler/SynchroniseAvs.hs +++ b/src/Jobs/Handler/SynchroniseAvs.hs @@ -173,7 +173,6 @@ dispatchJobSynchroniseAvsLicences = JobHandlerException $ do -- when (synchLevel 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 diff --git a/templates/avs.hamlet b/templates/avs.hamlet index f3c84153f..d52e32446 100644 --- a/templates/avs.hamlet +++ b/templates/avs.hamlet @@ -35,6 +35,9 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later $maybe answer <- mbQryLic

^{answer} + $maybe autodiffs <- mbAutoDiffs +

+ #{autodiffs}