chore(health): WIP new interface health handlers

models/audit.model

@@ -21,3 +21,12 @@ InterfaceLog
   success   Bool default=true     -- false logs a failure; but it will be overwritten by next transaction, but logged in TransactionLog
   UniqueInterfaceSubtypeWrite interface subtype write
   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

models/lms.model

@@ -20,7 +20,7 @@ Qualification
   SchoolQualificationShort school shorthand            -- must be unique per school and shorthand
   SchoolQualificationName  school name                 -- must be unique per school and name
   -- 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!
   deriving Eq Generic
 

routes

@@ -85,6 +85,8 @@
 /print/log                            PrintLogR       GET       !system-printer
 
 /health                       HealthR           GET             !free
+/health/interfaces            HealthInterfacesR GET             !free
+/health/interface/*Text       HealthInterfaceR  GET             !free
 /instance                     InstanceR         GET             !free
 /info                         InfoR             GET             !free
 /info/lecturer                InfoLecturerR     GET             !free

src/Database/Esqueleto/Utils.hs

@@ -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 _ = 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
   where 
     singleQuote     = Text.Builder.singleton '\''

src/Handler/Health/Interfaces.hs

@@ -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