@@ -24,6 +24,8 @@ import System.IO.Error (ioeGetErrorType)
2424import Control.Monad.Except (liftEither )
2525import Control.Monad.Extra (whenJust )
2626import Data.Either.Combinators (mapLeft , whenLeft )
27+ import Data.IORef (atomicWriteIORef , newIORef ,
28+ readIORef )
2729import Data.Maybe (fromJust )
2830import Data.String (IsString (.. ))
2931import Network.Wai.Handler.Warp (defaultSettings , setHost ,
@@ -63,11 +65,10 @@ import PostgREST.Version (docsVersion, prettyVersion)
6365
6466import qualified Data.ByteString.Char8 as BS
6567import qualified Data.List as L
66- import Data.Streaming.Network (bindPortTCP ,
67- bindRandomPortTCP )
68+ import Data.Streaming.Network (bindPortTCP )
6869import qualified Data.Text as T
6970import qualified Network.HTTP.Types as HTTP
70- import qualified Network.HTTP.Types.Header as HTTP ( hVary )
71+ import qualified Network.HTTP.Types.Header as HTTP
7172import qualified Network.Socket as NS
7273import PostgREST.Unix (createAndBindDomainSocket )
7374import Protolude hiding (Handler )
@@ -78,22 +79,30 @@ run :: AppState -> IO ()
7879run appState = do
7980 conf@ AppConfig {.. } <- AppState. getConfig appState
8081
81- AppState. schemaCacheLoader appState -- Loads the initial SchemaCache
82- (mainSocket, adminSocket) <- initSockets conf
82+ mainSocketRef <- newIORef Nothing
83+ adminSocket <- initAdminServerSocket conf
84+
8385 let closeSockets = do
8486 whenJust adminSocket NS. close
85- NS. close mainSocket
87+ readIORef mainSocketRef >>= foldMap NS. close
8688 Unix. installSignalHandlers observer closeSockets (AppState. schemaCacheLoader appState) (AppState. readInDbConfig False appState)
8789
90+ Admin. runAdmin appState adminSocket (readIORef mainSocketRef) (serverSettings conf)
91+
8892 Listener. runListener appState
8993
90- Admin. runAdmin appState adminSocket mainSocket (serverSettings conf)
94+ -- Kick off and wait for the initial SchemaCache load before creating the
95+ -- main API socket.
96+ AppState. schemaCacheLoader appState
97+ AppState. waitForSchemaCacheLoaded appState
98+
99+ mainSocket <- initServerSocket conf
100+ atomicWriteIORef mainSocketRef $ Just mainSocket
91101
92102 let app = postgrest configLogLevel appState (AppState. schemaCacheLoader appState)
93103
94- do
95- address <- resolveSocketToAddress mainSocket
96- observer $ AppServerAddressObs address
104+ address <- resolveSocketToAddress mainSocket
105+ observer $ AppServerAddressObs address
97106
98107 Warp. runSettingsSocket (serverSettings conf & setOnException onWarpException) mainSocket app
99108 where
@@ -251,38 +260,16 @@ addRetryHint delay response = do
251260isServiceUnavailable :: Wai. Response -> Bool
252261isServiceUnavailable response = Wai. responseStatus response == HTTP. status503
253262
254- type AppSockets = (NS. Socket , Maybe NS. Socket )
255-
256- initSockets :: AppConfig -> IO AppSockets
257- initSockets AppConfig {.. } = do
258- let
259- cfg'usp = configServerUnixSocket
260- cfg'uspm = configServerUnixSocketMode
261- cfg'host = configServerHost
262- cfg'port = configServerPort
263- cfg'adminHost = configAdminServerHost
264- cfg'adminPort = configAdminServerPort
265-
266- sock <- case cfg'usp of
267- -- I'm not using `streaming-commons`' bindPath function here because it's not defined for Windows,
268- -- but we need to have runtime error if we try to use it in Windows, not compile time error
269- Just path -> createAndBindDomainSocket path cfg'uspm
270- Nothing -> do
271- (_, sock) <-
272- if cfg'port /= 0
273- then do
274- sock <- bindPortTCP cfg'port (fromString $ T. unpack cfg'host)
275- pure (cfg'port, sock)
276- else do
277- -- explicitly bind to a random port, returning bound port number
278- (num, sock) <- bindRandomPortTCP (fromString $ T. unpack cfg'host)
279- pure (num, sock)
280- pure sock
281-
282- adminSock <- case cfg'adminPort of
283- Just adminPort -> do
284- adminSock <- bindPortTCP adminPort (fromString $ T. unpack cfg'adminHost)
285- pure $ Just adminSock
286- Nothing -> pure Nothing
287-
288- pure (sock, adminSock)
263+ initServerSocket :: AppConfig -> IO NS. Socket
264+ initServerSocket AppConfig {.. } = case configServerUnixSocket of
265+ -- I'm not using `streaming-commons`' bindPath function here because it's not defined for Windows,
266+ -- but we need to have runtime error if we try to use it in Windows, not compile time error
267+ Just path -> createAndBindDomainSocket path configServerUnixSocketMode
268+ Nothing -> bindPortTCP configServerPort (fromString $ T. unpack configServerHost)
269+
270+ initAdminServerSocket :: AppConfig -> IO (Maybe NS. Socket )
271+ initAdminServerSocket AppConfig {.. } =
272+ traverse (`bindPortTCP` adminHost) configAdminServerPort
273+ where
274+ adminHost = fromString $ T. unpack configAdminServerHost
275+
0 commit comments