log: add host to "Listening..." messages

This adds resolved host IPs to "listening..." messages emitted when app and admin server start
PostgREST · May 29, 2024 · 6dc6ed8 · 6dc6ed8
1 parent 82a43c2
commit 6dc6ed8
Show file tree

Hide file tree

Showing 5 changed files with 25 additions and 9 deletions.
diff --git a/postgrest.cabal b/postgrest.cabal
@@ -117,6 +117,7 @@ library
                     , http-types                >= 0.12.2 && < 0.13
                     , insert-ordered-containers >= 0.2.2 && < 0.3
                     , interpolatedstring-perl6  >= 1 && < 1.1
+                    , iproute                   >= 1.7.0 && < 1.8
                     , jose                      >= 0.8.5.1 && < 0.12
                     , lens                      >= 4.14 && < 5.3
                     , lens-aeson                >= 1.0.1 && < 1.3

diff --git a/src/PostgREST/Admin.hs b/src/PostgREST/Admin.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE LambdaCase     #-}
 {-# LANGUAGE NamedFieldPuns #-}
 
 module PostgREST.Admin
@@ -25,13 +26,15 @@ import qualified PostgREST.AppState as AppState
 import qualified PostgREST.Config   as Config
 
 
+import PostgREST.Unix (resolveHost)
 import Protolude
 
 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

diff --git a/src/PostgREST/App.hs b/src/PostgREST/App.hs
@@ -56,6 +56,7 @@ import qualified Data.ByteString.Char8 as BS
 import qualified Data.List             as L
 import qualified Network.HTTP.Types    as HTTP
 import qualified Network.Socket        as NS
+import           PostgREST.Unix        (resolveHost)
 import           Protolude             hiding (Handler)
 import           System.TimeIt         (timeItT)
 
@@ -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
 

diff --git a/src/PostgREST/Observation.hs b/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
   | DBConnectAttemptObs
   | ExitUnsupportedPgVersion PgVersion PgVersion
@@ -61,12 +61,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
   DBConnectAttemptObs ->

diff --git a/src/PostgREST/Unix.hs b/src/PostgREST/Unix.hs
@@ -3,6 +3,7 @@
 module PostgREST.Unix
   ( installSignalHandlers
   , createAndBindDomainSocket
+  , resolveHost
   ) where
 
 #ifndef mingw32_HOST_OS
@@ -11,7 +12,8 @@ import qualified System.Posix.Signals as Signals
 import System.Posix.Types       (FileMode)
 import System.PosixCompat.Files (setFileMode)
 
-import           Data.String      (String)
+import           Data.IP          (fromHostAddress, fromHostAddress6)
+import           Data.String      (IsString (..), String)
 import qualified Network.Socket   as NS
 import           Protolude
 import           System.Directory (removeFile)
@@ -51,3 +53,11 @@ createAndBindDomainSocket path mode = do
     handleDoesNotExist e
       | isDoesNotExistError e = return ()
       | otherwise = throwIO e
+
+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