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

chore(health): examining cause of #155

Browse Source
This commit is contained in:
Steffen Jost 2024-02-07 10:23:51 +01:00
parent 67552a666e
commit 618c78a69d
1 changed files with 21 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

39
src/Handler/Health/Interface.hs
View File

@ -100,18 +100,19 @@ runInterfaceLogTable interfs@(reqIfs,_) = do
allok = all snd res
return (missing, allok, res, twgt)
-- ihDebugShow :: Unique InterfaceHealth -> Text
-- ihDebugShow (UniqueInterfaceHealth i s w) = "(" <> tshow i <> tshow s <> tshow w <> ")"
ihDebugShow :: Unique InterfaceHealth -> Text
ihDebugShow (UniqueInterfaceHealth i s w) = "(" <> tshow i <> "," <> tshow s <> "," <> tshow w <> ")"
-- NOTE: Using (~~.) instead of ()=~.)
-- | like (=~.) but avoids condition entirely if second argument is Nothing; Note that using =~. with E.val Nothing did not work somehow!
infixl 4 ~~.
(~~.) :: PersistField typ => E.SqlExpr (E.Value typ) -> Maybe typ -> E.SqlExpr (E.Value Bool)
(~~.) a Nothing = E.true
(~~.) a (Just b) = a E.==. E.val b
-- infixl 4 ~~.
-- (~~.) :: PersistField typ => E.SqlExpr (E.Value typ) -> Maybe typ -> E.SqlExpr (E.Value Bool)
-- (~~.) _ Nothing = E.true
-- (~~.) a (Just b) = a E.==. E.val b
mkInterfaceLogTable :: (Bool -> Widget) -> ReqBanInterfaceHealth -> DB ([(Text,Bool)], Widget)
mkInterfaceLogTable flagError interfs@(reqIfs, banIfs) = do
-- $logWarnS "DEBUG" $ tshow ([ihDebugShow x | x<- reqIfs], [ihDebugShow x | x<- banIfs])
$logWarnS "DEBUG" $ tshow ([ihDebugShow x | x<- reqIfs], [ihDebugShow x | x<- banIfs])
void $ liftHandler $ timeoutHandler 42000001 $ runDB $ runInterfaceChecks interfs
now <- liftIO getCurrentTime
dbTableDB ilvalidator DBTable{dbtColonnade=colonnade now, ..}
@ -124,22 +125,24 @@ mkInterfaceLogTable flagError interfs@(reqIfs, banIfs) = do
E.&&. ilog E.^. InterfaceLogSubtype E.=~. E.joinV (ihealth E.?. InterfaceHealthSubtype)
E.&&. ilog E.^. InterfaceLogWrite E.=~. E.joinV (ihealth E.?. InterfaceHealthWrite )
)
let matchUIH crits = E.or
[ ilog E.^. InterfaceLogInterface E.==. E.val (sanitize ifce)
E.&&. ilog E.^. InterfaceLogSubtype ~~. (sanitize <$> subt)
E.&&. ilog E.^. InterfaceLogWrite ~~. writ
| (UniqueInterfaceHealth ifce subt writ) <- crits
]
-- let matchUIH crits = E.or
-- [ ilog E.^. InterfaceLogInterface E.==. E.val (sanitize ifce)
-- E.&&. ilog E.^. InterfaceLogSubtype ~~. (sanitize <$> subt)
-- E.&&. ilog E.^. InterfaceLogWrite ~~. writ
-- | (UniqueInterfaceHealth ifce subt writ) <- crits
-- ]
-- let matchUIH crits = E.or
-- [ E.and $ catMaybes
-- [ Just $ ilog E.^. InterfaceLogInterface E.==. E.val (sanitize ifce)
-- , foldMap ((ilog E.^. InterfaceLogSubtype E.==.) . E.val . sanitize) subt
-- , foldMap ((ilog E.^. InterfaceLogWrite E.==.) . E.val ) writ
-- [ ilog E.^. InterfaceLogInterface E.==. E.val (sanitize ifce) & Just
-- , (ilog E.^. InterfaceLogSubtype E.==.) . E.val . sanitize <$> subt
-- , (ilog E.^. InterfaceLogWrite E.==.) . E.val <$> writ
-- ]
-- | (UniqueInterfaceHealth ifce subt writ) <- crits
-- ]
unless (null reqIfs) $ E.where_ $ matchUIH reqIfs
unless (null banIfs) $ E.where_ $ E.not_ $ matchUIH banIfs
-- unless (null reqIfs) $ E.where_ $ matchUIH reqIfs
-- unless (null banIfs) $ E.where_ $ E.not_ $ matchUIH banIfs
E.where_ $ E.not_ (ilog E.^. InterfaceLogInterface E.==. E.val "LMS" E.&&. ilog E.^. InterfaceLogSubtype E.==. E.val (sanitize "F")) -- NOT OKAY ONLY Printer F SEE ISSUE #155
-- E.where_ $ ilog E.^. InterfaceLogInterface E.!=. E.val "LMS" E.||. ilog E.^. InterfaceLogSubtype E.!=. E.val (sanitize "F") -- OKAY
let ihour = E.coalesceDefault [ihealth E.?. InterfaceHealthHours] (E.val $ 3 * 24) -- if no default time is set, use 3 days instead
return (ilog, ihour)