fraport/fradrive-old
fraport/fradrive-old
Archived
3
1
Fork 0
Code Issues 65 Pull Requests 5 Actions Packages Projects Releases 197 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 allok = all snd res
return (missing, allok, res, twgt) return (missing, allok, res, twgt)
-- ihDebugShow :: Unique InterfaceHealth -> Text ihDebugShow :: Unique InterfaceHealth -> Text
-- ihDebugShow (UniqueInterfaceHealth i s w) = "(" <> tshow i <> tshow s <> tshow w <> ")" 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! -- | like (=~.) but avoids condition entirely if second argument is Nothing; Note that using =~. with E.val Nothing did not work somehow!
infixl 4 ~~. -- infixl 4 ~~.
(~~.) :: PersistField typ => E.SqlExpr (E.Value typ) -> Maybe typ -> E.SqlExpr (E.Value Bool) -- (~~.) :: PersistField typ => E.SqlExpr (E.Value typ) -> Maybe typ -> E.SqlExpr (E.Value Bool)
(~~.) a Nothing = E.true -- (~~.) _ Nothing = E.true
(~~.) a (Just b) = a E.==. E.val b -- (~~.) a (Just b) = a E.==. E.val b
mkInterfaceLogTable :: (Bool -> Widget) -> ReqBanInterfaceHealth -> DB ([(Text,Bool)], Widget) mkInterfaceLogTable :: (Bool -> Widget) -> ReqBanInterfaceHealth -> DB ([(Text,Bool)], Widget)
mkInterfaceLogTable flagError interfs@(reqIfs, banIfs) = do 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 void $ liftHandler $ timeoutHandler 42000001 $ runDB $ runInterfaceChecks interfs
now <- liftIO getCurrentTime now <- liftIO getCurrentTime
dbTableDB ilvalidator DBTable{dbtColonnade=colonnade now, ..} 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.^. InterfaceLogSubtype E.=~. E.joinV (ihealth E.?. InterfaceHealthSubtype)
E.&&. ilog E.^. InterfaceLogWrite E.=~. E.joinV (ihealth E.?. InterfaceHealthWrite ) E.&&. ilog E.^. InterfaceLogWrite E.=~. E.joinV (ihealth E.?. InterfaceHealthWrite )
) )
let matchUIH crits = E.or -- let matchUIH crits = E.or
[ ilog E.^. InterfaceLogInterface E.==. E.val (sanitize ifce) -- [ ilog E.^. InterfaceLogInterface E.==. E.val (sanitize ifce)
E.&&. ilog E.^. InterfaceLogSubtype ~~. (sanitize <$> subt) -- E.&&. ilog E.^. InterfaceLogSubtype ~~. (sanitize <$> subt)
E.&&. ilog E.^. InterfaceLogWrite ~~. writ -- E.&&. ilog E.^. InterfaceLogWrite ~~. writ
| (UniqueInterfaceHealth ifce subt writ) <- crits -- | (UniqueInterfaceHealth ifce subt writ) <- crits
] -- ]
-- let matchUIH crits = E.or -- let matchUIH crits = E.or
-- [ E.and $ catMaybes -- [ E.and $ catMaybes
-- [ Just $ ilog E.^. InterfaceLogInterface E.==. E.val (sanitize ifce) -- [ ilog E.^. InterfaceLogInterface E.==. E.val (sanitize ifce) & Just
-- , foldMap ((ilog E.^. InterfaceLogSubtype E.==.) . E.val . sanitize) subt -- , (ilog E.^. InterfaceLogSubtype E.==.) . E.val . sanitize <$> subt
-- , foldMap ((ilog E.^. InterfaceLogWrite E.==.) . E.val ) writ -- , (ilog E.^. InterfaceLogWrite E.==.) . E.val <$> writ
-- ] -- ]
-- | (UniqueInterfaceHealth ifce subt writ) <- crits -- | (UniqueInterfaceHealth ifce subt writ) <- crits
-- ] -- ]
unless (null reqIfs) $ E.where_ $ matchUIH reqIfs -- unless (null reqIfs) $ E.where_ $ matchUIH reqIfs
unless (null banIfs) $ E.where_ $ E.not_ $ matchUIH banIfs -- 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 let ihour = E.coalesceDefault [ihealth E.?. InterfaceHealthHours] (E.val $ 3 * 24) -- if no default time is set, use 3 days instead
return (ilog, ihour) return (ilog, ihour)