Right now listening sockets initialization, management and usage is split between App, AppState and Admin modules: they are created in AppState.init and remembered in AppState but used only in App and Admin. It has several negative consequences: - sockets are initialized even if not needed (eg. command line invocations like dump-config or dump-schema) - it is impossible to start listening on a socket after initial schema cache load because it requires AppState This change decouples listen socket management from AppState. Sockets are created only when needed (ie. not in command line tools invocation) and passed to admin application and to Warp by the App module.
76 lines
2.9 KiB
Haskell
76 lines
2.9 KiB
Haskell
module PostgREST.Admin
|
|
( runAdmin
|
|
) where
|
|
|
|
import qualified Data.Aeson as JSON
|
|
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 Network.Socket hiding (addrFamily)
|
|
import Network.Socket.ByteString
|
|
|
|
import PostgREST.AppState (AppState)
|
|
import PostgREST.MediaType (MediaType (..), toContentType)
|
|
import PostgREST.Metrics (metricsToText)
|
|
import PostgREST.Network (resolveSocketToAddress)
|
|
import PostgREST.Observation (Observation (..))
|
|
|
|
import qualified PostgREST.AppState as AppState
|
|
|
|
import qualified Network.Socket as NS
|
|
import Protolude
|
|
|
|
runAdmin :: AppState -> Maybe NS.Socket -> NS.Socket -> Warp.Settings -> IO ()
|
|
runAdmin appState maybeAdminSocket socketREST settings = do
|
|
whenJust maybeAdminSocket $ \adminSocket -> do
|
|
address <- resolveSocketToAddress adminSocket
|
|
observer $ AdminStartObs address
|
|
void . forkIO $ Warp.runSettingsSocket settings adminSocket adminApp
|
|
where
|
|
adminApp = admin appState socketREST
|
|
observer = AppState.getObserver appState
|
|
|
|
-- | PostgREST admin application
|
|
admin :: AppState.AppState -> NS.Socket -> Wai.Application
|
|
admin appState socketREST req respond = do
|
|
isMainAppReachable <- isRight <$> reachMainApp socketREST
|
|
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
|
|
["ready"] ->
|
|
let
|
|
status | not isMainAppReachable = HTTP.status500
|
|
| isPending = HTTP.status503
|
|
| isLoaded = HTTP.status200
|
|
| otherwise = HTTP.status500
|
|
in
|
|
respond $ Wai.responseLBS status [] mempty
|
|
["schema_cache"] -> do
|
|
sCache <- AppState.getSchemaCache appState
|
|
respond $ Wai.responseLBS HTTP.status200 [] (maybe mempty JSON.encode sCache)
|
|
["metrics"] -> do
|
|
mets <- metricsToText
|
|
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
|