From d0b2ffe93630eb5cafea92c7f4b1039391d005cd Mon Sep 17 00:00:00 2001
From: Gregor Kleen <kleen@cip.ifi.lmu.de>
Date: Tue, 30 Apr 2019 22:54:29 +0200
Subject: [PATCH] Prettier human-readable health reports

---
 messages/uniworx/de.msg | 10 +++++++++-
 src/Foundation.hs       | 20 ++++++++++++++++++++
 src/Handler/Health.hs   | 27 ++++++++++++++++++++++-----
 src/Utils.hs            |  4 ++++
 4 files changed, 55 insertions(+), 6 deletions(-)

diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg
index 259162ce0..7f0df9e9a 100644
--- a/messages/uniworx/de.msg
+++ b/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
\ No newline at end of file
+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
\ No newline at end of file
diff --git a/src/Foundation.hs b/src/Foundation.hs
index 1560cab35..d7b1060ae 100644
--- a/src/Foundation.hs
+++ b/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
diff --git a/src/Handler/Health.hs b/src/Handler/Health.hs
index d21b7734a..f3d5b4007 100644
--- a/src/Handler/Health.hs
+++ b/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">
-                #{report'}
+              $newline never
+              <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
diff --git a/src/Utils.hs b/src/Utils.hs
index 40fa580ee..7084ecbcb 100644
--- a/src/Utils.hs
+++ b/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 --