refactor: encapsulate how main application liveness check is done

This change makes Admin module independent from how liveness check is performed. It moves reachMainApp function to App module and makes Admin.runAdmin, instead of action to get the main socket, take an IO action checking liveness as a parameter.

Thanks to this, any change in how liveness check is performed and, more importantly, what data it uses, does not require changing multiple modules (Admin and App).

src/PostgREST/Admin.hs

@@ -7,9 +7,7 @@ import qualified Network.HTTP.Types.Status as HTTP
 import qualified Network.Wai               as Wai
 import qualified Network.Wai.Handler.Warp  as Warp
 
-import Control.Monad.Extra       (whenJust)
+import Control.Monad.Extra (whenJust)
-import Network.Socket            hiding (addrFamily)
-import Network.Socket.ByteString
 
 import PostgREST.AppState    (AppState, getConfig)
 import PostgREST.Config      (AppConfig (..))
@@ -23,15 +21,15 @@ import qualified PostgREST.AppState as AppState
 import qualified Network.Socket as NS
 import           Protolude
 
-runAdmin :: AppState -> Maybe NS.Socket -> IO (Maybe NS.Socket) -> Warp.Settings -> IO ()
+runAdmin :: AppState -> Maybe NS.Socket -> IO Bool -> Warp.Settings -> IO ()
-runAdmin appState maybeAdminSocket getSocketREST settings = do
+runAdmin appState maybeAdminSocket checkMainAppLive settings = do
   conf <- getConfig appState
   whenJust maybeAdminSocket $ \adminSocket -> do
     address <- resolveSocketToAddress adminSocket
     void . forkIO $ handle (onError adminSocket) $
       Warp.runSettingsSocket (adminServerSettings conf address) adminSocket adminApp
   where
-    adminApp = admin appState getSocketREST
+    adminApp = admin appState checkMainAppLive
     observer = AppState.getObserver appState
     adminServerSettings config addr=
       settings
@@ -43,19 +41,19 @@ runAdmin appState maybeAdminSocket getSocketREST settings = do
       NS.close adminSock -- we close the socket so request doesn't hang
 
 -- | PostgREST admin application
-admin :: AppState.AppState -> IO (Maybe NS.Socket) -> Wai.Application
+admin :: AppState.AppState -> IO Bool -> Wai.Application
-admin appState getSocketREST req respond = do
+admin appState checkMainAppLive req respond = do
-  isMainAppReachable <- getSocketREST >>= maybe (pure False) (fmap isRight . reachMainApp)
+  isMainAppLive <- checkMainAppLive
   isLoaded <- AppState.isLoaded appState
   isPending <- AppState.isPending appState
 
   case Wai.pathInfo req of
     ["live"] ->
-      respond $ Wai.responseLBS (if isMainAppReachable then HTTP.status200 else HTTP.status500) [] mempty
+      respond $ Wai.responseLBS (if isMainAppLive then HTTP.status200 else HTTP.status500) [] mempty
     ["ready"] ->
       let
         status | isPending              = HTTP.status503
-               | not isMainAppReachable = HTTP.status500
+               | not isMainAppLive      = HTTP.status500
                | isLoaded               = HTTP.status200
                | otherwise              = HTTP.status500
       in
@@ -68,18 +66,3 @@ admin appState getSocketREST req respond = do
       respond $ Wai.responseLBS HTTP.status200 [toContentType MTTextPlain] mets -- Content-Type is required for prometheus compliance
     _ ->
       respond $ Wai.responseLBS HTTP.status404 [] mempty
-
--- Try to connect to the main app socket
--- Note that it doesn't even send a valid HTTP request, we just want to check that the main app is accepting connections
-reachMainApp :: Socket -> IO (Either IOException ())
-reachMainApp appSock = do
-  sockAddr <- getSocketName appSock
-  sock <- socket (addrFamily sockAddr) Stream defaultProtocol
-  try $ do
-    connect sock sockAddr
-    withSocketsDo $ bracket (pure sock) close sendEmpty
-  where
-    sendEmpty sock = void $ send sock mempty
-    addrFamily (SockAddrInet _ _) = AF_INET
-    addrFamily (SockAddrInet6 {}) = AF_INET6
-    addrFamily (SockAddrUnix _)   = AF_UNIX

src/PostgREST/App.hs

@@ -72,6 +72,7 @@ import qualified Data.Text                 as T
 import qualified Network.HTTP.Types        as HTTP
 import           Network.HTTP.Types.Header (hVary)
 import qualified Network.Socket            as NS
+import           Network.Socket.ByteString (send)
 import           PostgREST.Unix            (createAndBindDomainSocket)
 import           System.Posix.Types        (FileMode)
 
@@ -89,7 +90,7 @@ run appState = do
         readIORef mainSocketRef >>= foldMap NS.close
   Unix.installSignalHandlers observer closeSockets (AppState.schemaCacheLoader appState) (AppState.readInDbConfig False appState)
 
-  Admin.runAdmin appState adminSocket (readIORef mainSocketRef) (serverSettings conf)
+  Admin.runAdmin appState adminSocket (checkMainAppLive (readIORef mainSocketRef)) (serverSettings conf)
 
   Listener.runListener appState
 
@@ -291,3 +292,22 @@ initAdminServerSocket AppConfig{..} =
   initSocket
     configAdminServerUnixSocket configAdminServerUnixSocketMode
     configAdminServerHost configAdminServerPort
+
+checkMainAppLive :: IO (Maybe NS.Socket) -> IO Bool
+checkMainAppLive getMainSocket =
+  getMainSocket >>= maybe (pure False) (fmap isRight . reachMainApp)
+
+-- Try to connect to the main app socket
+-- Note that it doesn't even send a valid HTTP request, we just want to check that the main app is accepting connections
+reachMainApp :: NS.Socket -> IO (Either IOException ())
+reachMainApp appSock = do
+  sockAddr <- NS.getSocketName appSock
+  sock <- NS.socket (addrFamily sockAddr) NS.Stream NS.defaultProtocol
+  try $ do
+    NS.connect sock sockAddr
+    NS.withSocketsDo $ bracket (pure sock) NS.close sendEmpty
+  where
+    sendEmpty sock = void $ send sock mempty
+    addrFamily (NS.SockAddrInet _ _) = NS.AF_INET
+    addrFamily (NS.SockAddrInet6 {}) = NS.AF_INET6
+    addrFamily (NS.SockAddrUnix _)   = NS.AF_UNIX