chore(avs): debug automatic avs licence synch within admin avs test page
This commit is contained in:
parent
3c5edb1b97
commit
f0798e8836
@ -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|
|
||||
<h2>Licence check differences:
|
||||
<h3>Grant R:
|
||||
<p>
|
||||
#{r_grant}
|
||||
<h3>Set to F:
|
||||
<p>
|
||||
#{f_set}
|
||||
<h3>Revoke licence:
|
||||
<p>
|
||||
#{revoke}
|
||||
<dl .deflist>
|
||||
<dt .deflist__dt>Grant R (#{rg_size}):
|
||||
<dd .deflist__dd>#{r_grant}
|
||||
|
||||
<dt .deflist__dt>Set to F (#{fs_size}):
|
||||
<dd .deflist__dd>#{f_set}
|
||||
|
||||
<dt .deflist__dt>Revoke licence (#{rv_size}):
|
||||
<dd .deflist__dd>#{revoke}
|
||||
|]
|
||||
(Left e) -> do
|
||||
let msg = tshow (e :: SomeException)
|
||||
return $ Just [whamlet|<h2>Licence check error:</h2> #{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|
|
||||
<dt .deflist__dt>#{subtype} (#{n}):
|
||||
<dd .deflist__dd>#{showApids apids}
|
||||
|]
|
||||
else
|
||||
[shamlet|
|
||||
<dt .deflist__dt>#{subtype} (#{n}):
|
||||
<dd .deflist__dd>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|
|
||||
<h3>
|
||||
Next automatic AVS licence synchronisation:
|
||||
<dl .deflist>
|
||||
^{l4}
|
||||
^{l3}
|
||||
^{l2}
|
||||
^{l1}
|
||||
$maybe reason <- reasonFilter
|
||||
<dt .deflist__dt>Filter "#{reason}" (#{Set.size multiFirmBlocks}):
|
||||
<dd .deflist__dd>#{showApids multiFirmBlocks}
|
||||
|]
|
||||
return (basediffs, autoDiffs)
|
||||
|
||||
-- (Just BtnSynchLicences) -> do
|
||||
-- res <- try synchAvsLicences
|
||||
-- case res of
|
||||
|
||||
@ -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
|
||||
|
||||
@ -35,6 +35,9 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
|
||||
$maybe answer <- mbQryLic
|
||||
<p>
|
||||
^{answer}
|
||||
$maybe autodiffs <- mbAutoDiffs
|
||||
<p>
|
||||
#{autodiffs}
|
||||
|
||||
<section>
|
||||
<p>
|
||||
|
||||
Loading…
Reference in New Issue
Block a user