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

refactor(avs): show avs problems within interface table

Browse Source
This commit is contained in:
Steffen Jost 2023-12-07 17:32:51 +01:00
parent fb20defc42
commit 5c8a571c76
1 changed files with 34 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

39
src/Handler/Admin.hs
View File

@ -49,8 +49,7 @@ getAdminProblemsR = do
msgErrorTooltip <- messageI Error MsgMessageError
let flagError = messageTooltip . bool msgErrorTooltip msgSuccessTooltip
flagWarning = messageTooltip . bool msgWarningTooltip msgSuccessTooltip
flagOld = flagError . (cutOffOldTime <)
flagWarning = messageTooltip . bool msgWarningTooltip msgSuccessTooltip
flagNonZero :: Int -> Widget
flagNonZero n | n <= 0 = flagError True
| otherwise = messageTooltip =<< handlerToWidget (messageI Error (MsgProblemsDriverSynch n))
@ -62,7 +61,7 @@ getAdminProblemsR = do
<*> (not <$> exists [PrintJobAcknowledged ==. Nothing, PrintJobCreated <. cutOffOldTime])
<*> (not <$> exists [PrintAcknowledgeProcessed ==. False])
<*> (not <$> exists [UserAvsLastSynchError !=. Nothing])
<*> fmap (view _2) (mkInterfaceLogTable flagOld)
<*> fmap (view _2) (mkInterfaceLogTable flagError cutOffOldTime)
diffLics <- try retrieveDifferingLicences >>= \case
-- (Left (UnsupportedContentType "text/html" resp)) -> Left $ text2widget "Html received"
(Left e) -> return $ Left $ text2widget $ tshow (e :: SomeException)
@ -239,9 +238,37 @@ retrieveDriversRWithoutF now = do
return usr
mkInterfaceLogTable :: (UTCTime -> Widget) -> DB (Any, Widget)
mkInterfaceLogTable flagOld = do
mkInterfaceLogTable :: (Bool -> Widget) -> UTCTime -> DB (Any, Widget)
mkInterfaceLogTable flagError cutOffOldTime = do
avsSynchStats <- E.select $ do
uavs <- E.from $ E.table @UserAvs
E.where_ $ uavs E.^. UserAvsLastSynch E.>. E.val cutOffOldTime
let isOk = E.isNothing (uavs E.^. UserAvsLastSynchError)
E.groupBy isOk
-- E.orderBy [E.descNullsLast isOk]
return (isOk, E.countRows, E.max_ $ uavs E.^. UserAvsLastSynch)
let
mkBadInfo badRows (fromMaybe cutOffOldTime -> badTime) =
if badRows > 0 then tshow badRows <> " errors, last " <> tshow (utctDay badTime) else mempty
writeAvsSynchStats okRows (fromMaybe cutOffOldTime -> okTime) badInfo =
void $ upsertBy (UniqueInterfaceSubtypeWrite "AVS" "Synch" True)
(InterfaceLog "AVS" "Synch" True okTime okRows badInfo)
[InterfaceLogTime =. okTime, InterfaceLogRows =. okRows, InterfaceLogInfo =. badInfo]
--case $(unValueN 3) <$> avsSynchStats of
case avsSynchStats of
((E.Value True , E.Value okRows, E.Value okTime):(E.Value False, E.Value badRows, E.Value badTime):_) ->
writeAvsSynchStats (Just okRows) okTime $ mkBadInfo badRows badTime
((E.Value True , E.Value okRows, E.Value okTime):_) ->
writeAvsSynchStats (Just okRows) okTime mempty
((E.Value False, E.Value badRows, E.Value badTime):_) ->
writeAvsSynchStats Nothing Nothing $ mkBadInfo badRows badTime
_ -> return ()
let
flagOld = flagError . (cutOffOldTime <)
resultDBTable = DBTable{..}
where
resultILog :: Lens' (DBRow (Entity InterfaceLog)) InterfaceLog
@ -254,6 +281,7 @@ mkInterfaceLogTable flagOld = do
, sortable (Just "interface") (textCell "Interface") $ \(view (resultILog . _interfaceLogInterface) -> n) -> textCell n
, sortable (Just "subtype") (textCell "Art" ) $ textCell . view (resultILog . _interfaceLogSubtype)
, sortable (Just "write") (textCell "Write" ) $ (`ifIconCell` IconEdit) . view (resultILog . _interfaceLogWrite)
, sortable (Just "rows") (textCell "Zeilen" ) $ cellMaybe numCell . view (resultILog . _interfaceLogRows)
, sortable Nothing (textCell "Info" ) $ textCell . view (resultILog . _interfaceLogInfo)
, sortable (Just "time") (i18nCell MsgSystemMessageTimestamp) $ dateTimeCell . view (resultILog . _interfaceLogTime)
]
@ -261,6 +289,7 @@ mkInterfaceLogTable flagOld = do
[ singletonMap "interface" $ SortColumn (E.^. InterfaceLogInterface)
, singletonMap "subtype" $ SortColumn (E.^. InterfaceLogSubtype)
, singletonMap "write" $ SortColumn (E.^. InterfaceLogWrite)
, singletonMap "rows" $ SortColumn (E.^. InterfaceLogRows)
, singletonMap "time" $ SortColumn (E.^. InterfaceLogTime)
]
dbtFilter = mempty