Prettier human-readable health reports

messages/uniworx/de.msg

@@ -700,6 +700,8 @@ MenuInformation: Informationen
 MenuImpressum: Impressum
 MenuDataProt: Datenschutz
 MenuVersion: Versionsgeschichte
+MenuInstance: Instanz-Identifikation
+MenuHealth: Instanz-Zustand
 MenuHelp: Hilfe
 MenuProfile: Anpassen
 MenuLogin: Login
@@ -881,4 +883,10 @@ HealthReport: Instanz-Zustand
 InstanceIdentification: Instanz-Identifikation
 
 InstanceId: Instanz-Nummer
-ClusterId: Cluster-Nummer
+ClusterId: Cluster-Nummer
+
+HealthMatchingClusterConfig: Cluster-geteilte Konfiguration ist aktuell
+HealthHTTPReachable: Cluster kann an der erwarteten URL über HTTP erreicht werden
+HealthLDAPAdmins: Anteil der Administratoren, die im LDAP-Verzeichnis gefunden werden können
+HealthSMTPConnect: SMTP-Server kann erreicht werden
+HealthWidgetMemcached: Memcached-Server liefert Widgets korrekt aus

src/Foundation.hs

@@ -1655,6 +1655,26 @@ pageActions (VersionR) = [
       , menuItemAccessCallback' = return True
       }
   ]
+pageActions  HealthR = [
+    MenuItem
+      { menuItemType  = PageActionPrime
+      , menuItemLabel = MsgMenuInstance
+      , menuItemIcon  = Nothing
+      , menuItemRoute = SomeRoute InstanceR
+      , menuItemModal = False
+      , menuItemAccessCallback' = return True
+      }
+  ]
+pageActions  InstanceR = [
+    MenuItem
+      { menuItemType  = PageActionPrime
+      , menuItemLabel = MsgMenuHealth
+      , menuItemIcon  = Nothing
+      , menuItemRoute = SomeRoute HealthR
+      , menuItemModal = False
+      , menuItemAccessCallback' = return True
+      }
+  ]
 pageActions (HelpR) = [
     -- MenuItem
     --   { menuItemType = PageActionPrime

src/Handler/Health.hs

@@ -7,6 +7,8 @@ import qualified Data.Text.Lazy.Builder as Builder
 
 import Utils.Lens
 
+import qualified Data.UUID as UUID
+
 
 getHealthR :: Handler TypedContent
 getHealthR = do
@@ -24,10 +26,24 @@ getHealthR = do
         provideRep $
           siteLayoutMsg MsgHealthReport $ do
             setTitleI MsgHealthReport
-            let report' = Aeson.encodePrettyToTextBuilder healthReport
+            let HealthReport{..} = healthReport
             [whamlet|
-              <pre style="font-family: monospace; white-space: pre-wrap">
+              $newline never
-                #{report'}
+              <dl .deflist>
+                <dt .deflist__dt>_{MsgHealthMatchingClusterConfig}
+                <dd .deflist__dd>#{boolSymbol healthMatchingClusterConfig}
+                $maybe httpReachable <- healthHTTPReachable
+                  <dt .deflist__dt>_{MsgHealthHTTPReachable}
+                  <dd .deflist__dd>#{boolSymbol httpReachable}
+                $maybe ldapAdmins <- healthLDAPAdmins
+                  <dt .deflist__dt>_{MsgHealthLDAPAdmins}
+                  <dd .deflist__dd>#{textPercent ldapAdmins}
+                $maybe smtpConnect <- healthSMTPConnect
+                  <dt .deflist__dt>_{MsgHealthSMTPConnect}
+                  <dd .deflist__dd>#{boolSymbol smtpConnect}
+                $maybe widgetMemcached <- healthWidgetMemcached
+                  <dt .deflist__dt>_{MsgHealthWidgetMemcached}
+                  <dd .deflist__dd>#{boolSymbol widgetMemcached}
             |]
         provideJson healthReport
         provideRep . return . Builder.toLazyText $ Aeson.encodePrettyToTextBuilder healthReport
@@ -51,11 +67,12 @@ getInstanceR = do
       siteLayoutMsg MsgInstanceIdentification $ do
         setTitleI MsgInstanceIdentification
         [whamlet|
+          $newline never
           <dl .deflist>
             <dt .deflist__dt>_{MsgClusterId}
-            <dd .deflist__dd style="font-family: monospace">#{tshow clusterId}
+            <dd .deflist__dd style="font-family: monospace">#{UUID.toText clusterId}
             <dt .deflist__dt>_{MsgInstanceId}
-            <dd .deflist__dd style="font-family: monospace">#{tshow instanceId}
+            <dd .deflist__dd style="font-family: monospace">#{UUID.toText instanceId}
         |]
     provideJson instanceInfo
     provideRep . return $ tshow instanceInfo

src/Utils.hs

@@ -152,6 +152,10 @@ isNew :: Bool -> Markup
 isNew True  = [shamlet|<i .fas .fa-seedling>|] -- was exclamation
 isNew False = mempty
 
+boolSymbol :: Bool -> Markup
+boolSymbol True  = [shamlet|<i .fas .fa-check>|]
+boolSymbol False = [shamlet|<i .fas .fa-times>|]
+
 
 ---------------------
 -- Text and String --