feat: Add resolved host to "Listening on ..." messages (#3560)

This adds resolved host's IP to "Listening on ..." messages emitted when
app and admin servers start.

src/PostgREST/Admin.hs

@@ -19,6 +19,7 @@ import Network.Socket.ByteString
 import PostgREST.AppState    (AppState)
 import PostgREST.Config      (AppConfig (..))
 import PostgREST.Metrics     (metricsToText)
+import PostgREST.Network     (resolveHost)
 import PostgREST.Observation (Observation (..))
 
 import qualified PostgREST.AppState as AppState
@@ -31,7 +32,8 @@ runAdmin :: AppState -> Warp.Settings -> IO ()
 runAdmin appState settings = do
   AppConfig{configAdminServerPort} <- AppState.getConfig appState
   whenJust (AppState.getSocketAdmin appState) $ \adminSocket -> do
-    observer $ AdminStartObs configAdminServerPort
+    host <- resolveHost adminSocket
+    observer $ AdminStartObs host configAdminServerPort
     void . forkIO $ Warp.runSettingsSocket settings adminSocket adminApp
   where
     adminApp = admin appState

src/PostgREST/App.hs

@@ -46,6 +46,7 @@ import PostgREST.Auth                 (AuthResult (..))
 import PostgREST.Config               (AppConfig (..), LogLevel (..))
 import PostgREST.Config.PgVersion     (PgVersion (..))
 import PostgREST.Error                (Error)
+import PostgREST.Network              (resolveHost)
 import PostgREST.Observation          (Observation (..))
 import PostgREST.Response.Performance (ServerTiming (..),
                                        serverTimingHeader)
@@ -82,7 +83,8 @@ run appState = do
       observer $ AppServerUnixObs path
     Nothing   -> do
       port <- NS.socketPort $ AppState.getSocketREST appState
-      observer $ AppServerPortObs port
+      host <- resolveHost $ AppState.getSocketREST appState
+      observer $ AppServerPortObs (fromJust host) port
 
   Warp.runSettingsSocket (serverSettings conf) (AppState.getSocketREST appState) app
 

src/PostgREST/Network.hs

@@ -0,0 +1,17 @@
+module PostgREST.Network
+  ( resolveHost
+  ) where
+
+import           Data.IP        (fromHostAddress, fromHostAddress6)
+import           Data.String    (IsString (..))
+import qualified Network.Socket as NS
+
+import Protolude
+
+resolveHost :: NS.Socket -> IO (Maybe Text)
+resolveHost sock = do
+  sn <- NS.getSocketName sock
+  case sn of
+    NS.SockAddrInet _ hostAddr ->  pure $ Just $ fromString $ show $ fromHostAddress hostAddr
+    NS.SockAddrInet6 _ _ hostAddr6 _ -> pure $ Just $ fromString $ show $ fromHostAddress6 hostAddr6
+    _ -> pure Nothing

src/PostgREST/Observation.hs

@@ -25,9 +25,9 @@ import Protolude
 import Protolude.Partial (fromJust)
 
 data Observation
-  = AdminStartObs (Maybe Int)
+  = AdminStartObs (Maybe Text) (Maybe Int)
   | AppStartObs ByteString
-  | AppServerPortObs NS.PortNumber
+  | AppServerPortObs Text NS.PortNumber
   | AppServerUnixObs FilePath
   | ExitUnsupportedPgVersion PgVersion PgVersion
   | ExitDBNoRecoveryObs
@@ -60,12 +60,12 @@ type ObservationHandler = Observation -> IO ()
 
 observationMessage :: Observation -> Text
 observationMessage = \case
-  AdminStartObs port ->
-    "Admin server listening on port " <> show (fromIntegral (fromJust port) :: Integer)
+  AdminStartObs host port ->
+    "Admin server listening on " <> fromJust host <> ":" <> show (fromIntegral (fromJust port) :: Integer)
   AppStartObs ver ->
     "Starting PostgREST " <> T.decodeUtf8 ver <> "..."
-  AppServerPortObs port ->
-    "Listening on port " <> show port
+  AppServerPortObs host port ->
+    "Listening on " <> host <> ":" <> show port
   AppServerUnixObs sock ->
     "Listening on unix socket " <> show sock
   DBConnectedObs ver ->