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

chore(health): WIP new interface health handlers

Browse Source
This commit is contained in:
Steffen Jost 2024-01-31 18:03:25 +01:00
parent 798a07e36c
commit a592ad7094
5 changed files with 84 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
models/audit.model
View File

@ -20,4 +20,13 @@ InterfaceLog
info Text -- addtional status information info Text -- addtional status information
success Bool default=true -- false logs a failure; but it will be overwritten by next transaction, but logged in TransactionLog success Bool default=true -- false logs a failure; but it will be overwritten by next transaction, but logged in TransactionLog
UniqueInterfaceSubtypeWrite interface subtype write UniqueInterfaceSubtypeWrite interface subtype write
deriving Eq Read Show Generic deriving Eq Read Show Generic
InterfaceHealth
interface Text
subtype Text Maybe
write Bool Maybe
hours Int
message Text Maybe
UniqueInterfaceHealth interface subtype write !force -- Note that nullable fields must be either empty or unique
deriving Eq Read Show Generic

2
models/lms.model
View File

@ -20,7 +20,7 @@ Qualification
SchoolQualificationShort school shorthand -- must be unique per school and shorthand SchoolQualificationShort school shorthand -- must be unique per school and shorthand
SchoolQualificationName school name -- must be unique per school and name SchoolQualificationName school name -- must be unique per school and name
-- across all schools, only one qualification may be a driving licence: -- across all schools, only one qualification may be a driving licence:
UniqueQualificationAvsLicence avsLicence !force UniqueQualificationAvsLicence avsLicence !force -- either empty or unique
-- NOTE: two NULL values are not equal for the purpose of Uniqueness constraints! -- NOTE: two NULL values are not equal for the purpose of Uniqueness constraints!
deriving Eq Generic deriving Eq Generic

30
routes
View File

@ -84,20 +84,22 @@
/print/download/#CryptoUUIDPrintJob PrintDownloadR GET !system-printer /print/download/#CryptoUUIDPrintJob PrintDownloadR GET !system-printer
/print/log PrintLogR GET !system-printer /print/log PrintLogR GET !system-printer
/health HealthR GET !free /health HealthR GET !free
/instance InstanceR GET !free /health/interfaces HealthInterfacesR GET !free
/info InfoR GET !free /health/interface/*Text HealthInterfaceR GET !free
/info/lecturer InfoLecturerR GET !free /instance InstanceR GET !free
/info/supervisor InfoSupervisorR GET !free /info InfoR GET !free
/info/legal LegalR GET !free /info/lecturer InfoLecturerR GET !free
/info/glossary GlossaryR GET !free /info/supervisor InfoSupervisorR GET !free
/info/faq FaqR GET !free /info/legal LegalR GET !free
/info/terms-of-use TermsOfUseR GET !free /info/glossary GlossaryR GET !free
/info/payments PaymentsR GET !free /info/faq FaqR GET !free
/imprint ImprintR GET !free /info/terms-of-use TermsOfUseR GET !free
/data-protection DataProtectionR GET !free /info/payments PaymentsR GET !free
/version VersionR GET !free /imprint ImprintR GET !free
/status StatusR GET !free /data-protection DataProtectionR GET !free
/version VersionR GET !free
/status StatusR GET !free
/help HelpR GET POST !free /help HelpR GET POST !free

11
src/Database/Esqueleto/Utils.hs
View File

@ -700,6 +700,17 @@ dayMaybe = E.unsafeSqlCastAs "date"
interval :: CalendarDiffDays -> E.SqlExpr (E.Value Day) -- E.+=. requires both types to be the same, so we use Day interval :: CalendarDiffDays -> E.SqlExpr (E.Value Day) -- E.+=. requires both types to be the same, so we use Day
-- interval _ = E.unsafeSqlCastAs "interval" $ E.unsafeSqlValue "'P2Y'" -- tested working example -- interval _ = E.unsafeSqlCastAs "interval" $ E.unsafeSqlValue "'P2Y'" -- tested working example
interval = E.unsafeSqlCastAs "interval". E.unsafeSqlValue . wrapSqlString . Text.Builder.fromString . iso8601Show
where
singleQuote = Text.Builder.singleton '\''
wrapSqlString b = singleQuote <> b <> singleQuote
addHours :: E.SqlExpr (E.Value Int) -> E.SqlExpr (E.Value UTCTime) -> E.SqlExpr (E.Value UTCTime)
addHours
-- E.+=. requires both types to be the same, so we use Day
-- interval _ = E.unsafeSqlCastAs "interval" $ E.unsafeSqlValue "'P2Y'" -- tested working example
interval = E.unsafeSqlCastAs "interval". E.unsafeSqlValue . wrapSqlString . Text.Builder.fromString . iso8601Show interval = E.unsafeSqlCastAs "interval". E.unsafeSqlValue . wrapSqlString . Text.Builder.fromString . iso8601Show
where where
singleQuote = Text.Builder.singleton '\'' singleQuote = Text.Builder.singleton '\''

46
src/Handler/Health/Interfaces.hs Normal file
View File

@ -0,0 +1,46 @@
-- SPDX-FileCopyrightText: 2024 Steffen Jost <s.jost@fraport.de>
--
-- SPDX-License-Identifier: AGPL-3.0-or-later
module Handler.Health.Interfaces where
import Import
import Database.Esqueleto.Experimental ((:&)(..))
import qualified Database.Esqueleto.Experimental as E
import qualified Database.Esqueleto.Utils as E
getHealthInterfacesR :: Handler Html
getHealthInterfacesR = auxHealthInterfaces []
getHealthInterfaceR :: [Text] -> Handler Html
getHealthInterfaceR ["*"] = auxHealthInterfaces []
getHealthInterfaceR [i] = auxHealthInterfaces [(i, Nothing, Nothing)]
getHealthInterfaceR [i,s] = auxHealthInterfaces [(i, Just s, Nothing)]
getHealthInterfaceR [i,s, Text.toLower . Text.strip -> w]
| w `elem` ["1", "t", "true" ,"wahr", "w"] = auxHealthInterfaces [(i, Just s, Just True )]
| w `elem` ["0", "f", "false","falsch"] = auxHealthInterfaces [(i, Just s, Just False)]
-- TODO: also allow '*' for wildcards and cycle; better write separate parse function
getHealthInterfaceR _ = notFound
auxHealthInterfaces :: [(Text, Maybe Text, Maybe Bool)] -> Handler Html
auxHealthInterfaces interfs = do
_TODO <- runDB $ E.select $ do
(ilog :& ihealth) <- E.from (E.table @InterfaceLog
`E.leftJoin` E.table @InterfaceHealth
`E.on` (\(ilog :& ihealth) ->
ilog E.^. InterfaceLogInterface E.=?. ihealth E.?. InterfaceHealthInterface
E.&&. ilog E.^. InterfaceLogSubtype E.=~. E.joinV (ihealth E.?. InterfaceHealthSubtype)
E.&&. ilog E.^. InterfaceLogWrite E.=~. E.joinV (ihealth E.?. InterfaceHealthWrite )
))
unless (null interfs) $
E.where_ $ E.or [ ilog E.^. InterfaceInterface E.==. E.val ifce
E.&&. ilog E.^. InterfaceSubtype E.=~. E.val subt
E.&&. ilog E.^. InterfaceWrite E.=~. E.val writ
| (ifce, subt, writ) <- interfs
]
let ihour = E.coalesceDefault [E.joinV (ihealth E.?. InterfaceHealthHours)] (E.val 48)
return (ilog, ihour, E.joinV $ ihealth E.?. InterfaceHealthMessage)
notFound