Display instance host at the top of all pages

config/settings-default.yaml

@@ -24,6 +24,8 @@ ip-from-header: "_env:IP_FROM_HEADER:false"
 # Uncomment to set an explicit approot
 #approot:        "_env:APPROOT:http://localhost:3000"
 
+instance-host:  "_env:INSTANCE_HOST:localhost"
+
 # Encryption key file for encrypting the session cookie sent to clients
 client-session-key:     config/client_session_key.aes
 

src/Vervis/Foundation.hs

@@ -174,6 +174,7 @@ instance Yesod App where
         pc <- widgetToPageContent $ do
             setTitle $ toHtml $
                 T.intercalate " → " (map snd bcs) <> " → " <> title
+            let instanceHost = appInstanceHost $ appSettings master
             $(widgetFile "default-layout")
         withUrlRenderer $(hamletFile "templates/default-layout-wrapper.hamlet")
 

src/Vervis/Settings.hs

@@ -59,6 +59,9 @@ data AppSettings = AppSettings
       -- | Base for all generated URLs. If @Nothing@, determined from the
       -- request headers.
     , appRoot                   :: Maybe Text
+      -- | The instance's host (e.g. \"dev.angeley.es\"), currently used just
+      -- for display.
+    , appInstanceHost           :: Text
       -- | Host/interface the server should bind to.
     , appHost                   :: HostPreference
       -- | Port to listen on
@@ -143,6 +146,7 @@ instance FromJSON AppSettings where
         appMaxInstanceKeys        <- o .:? "max-instance-keys"
         appMaxActorKeys           <- o .:? "max-actor-keys"
         appRoot                   <- o .:? "approot"
+        appInstanceHost           <- o .: "instance-host"
         appHost                   <- fromString <$> o .: "host"
         appPort                   <- o .: "http-port"
         appIpFromHeader           <- o .: "ip-from-header"

templates/default-layout.cassius

@@ -57,3 +57,7 @@ input[type="submit"]
     padding:       0.618em
     border:        none
     border-radius: 0.618em
+
+.instance
+    color: #{light blue}
+    font:  180% monospace

templates/default-layout.hamlet

@@ -33,6 +33,9 @@ $nothing
   UPDATE: Federation is coming!
   <a href=@{OutboxR}>Very early testing
 
+<.instance>
+  Vervis @ #{instanceHost}
+
 ^{breadcrumbsW}
 
 $maybe msg <- mmsg