@@ -25,6 +25,8 @@ import System.IO.Error (ioeGetErrorType)
2525import Control.Monad.Except (liftEither )
2626import Control.Monad.Extra (whenJust )
2727import Data.Either.Combinators (mapLeft , whenLeft )
28+ import Data.IORef (atomicWriteIORef , newIORef ,
29+ readIORef )
2830import Data.String (IsString (.. ))
2931import Network.Wai.Handler.Warp (defaultSettings , setHost ,
3032 setOnException , setPort ,
@@ -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 )
@@ -76,22 +77,30 @@ run :: AppState -> IO ()
7677run appState = do
7778 conf <- AppState. getConfig appState
7879
79- AppState. schemaCacheLoader appState -- Loads the initial SchemaCache
80- (mainSocket, adminSocket) <- initSockets conf
80+ mainSocketRef <- newIORef Nothing
81+ adminSocket <- initAdminServerSocket conf
82+
8183 let closeSockets = do
8284 whenJust adminSocket NS. close
83- NS. close mainSocket
85+ readIORef mainSocketRef >>= foldMap NS. close
8486 Unix. installSignalHandlers observer closeSockets (AppState. schemaCacheLoader appState) (AppState. readInDbConfig False appState)
8587
88+ Admin. runAdmin appState adminSocket (readIORef mainSocketRef) (serverSettings conf)
89+
8690 Listener. runListener appState
8791
88- Admin. runAdmin appState adminSocket mainSocket (serverSettings conf)
92+ -- Kick off and wait for the initial SchemaCache load before creating the
93+ -- main API socket.
94+ AppState. schemaCacheLoader appState
95+ AppState. waitForSchemaCacheInit appState
96+
97+ mainSocket <- initServerSocket conf
98+ atomicWriteIORef mainSocketRef $ Just mainSocket
8999
90100 let app = postgrest appState (AppState. schemaCacheLoader appState)
91101
92- do
93- address <- resolveSocketToAddress mainSocket
94- observer $ AppServerAddressObs address
102+ address <- resolveSocketToAddress mainSocket
103+ observer $ AppServerAddressObs address
95104
96105 Warp. runSettingsSocket (serverSettings conf & setOnException onWarpException) mainSocket app
97106 where
@@ -258,38 +267,16 @@ addRetryHint delay response = do
258267isServiceUnavailable :: Wai. Response -> Bool
259268isServiceUnavailable response = Wai. responseStatus response == HTTP. status503
260269
261- type AppSockets = (NS. Socket , Maybe NS. Socket )
262-
263- initSockets :: AppConfig -> IO AppSockets
264- initSockets AppConfig {.. } = do
265- let
266- cfg'usp = configServerUnixSocket
267- cfg'uspm = configServerUnixSocketMode
268- cfg'host = configServerHost
269- cfg'port = configServerPort
270- cfg'adminHost = configAdminServerHost
271- cfg'adminPort = configAdminServerPort
272-
273- sock <- case cfg'usp of
274- -- I'm not using `streaming-commons`' bindPath function here because it's not defined for Windows,
275- -- but we need to have runtime error if we try to use it in Windows, not compile time error
276- Just path -> createAndBindDomainSocket path cfg'uspm
277- Nothing -> do
278- (_, sock) <-
279- if cfg'port /= 0
280- then do
281- sock <- bindPortTCP cfg'port (fromString $ T. unpack cfg'host)
282- pure (cfg'port, sock)
283- else do
284- -- explicitly bind to a random port, returning bound port number
285- (num, sock) <- bindRandomPortTCP (fromString $ T. unpack cfg'host)
286- pure (num, sock)
287- pure sock
288-
289- adminSock <- case cfg'adminPort of
290- Just adminPort -> do
291- adminSock <- bindPortTCP adminPort (fromString $ T. unpack cfg'adminHost)
292- pure $ Just adminSock
293- Nothing -> pure Nothing
294-
295- pure (sock, adminSock)
270+ initServerSocket :: AppConfig -> IO NS. Socket
271+ initServerSocket AppConfig {.. } = case configServerUnixSocket of
272+ -- I'm not using `streaming-commons`' bindPath function here because it's not defined for Windows,
273+ -- but we need to have runtime error if we try to use it in Windows, not compile time error
274+ Just path -> createAndBindDomainSocket path configServerUnixSocketMode
275+ Nothing -> bindPortTCP configServerPort (fromString $ T. unpack configServerHost)
276+
277+ initAdminServerSocket :: AppConfig -> IO (Maybe NS. Socket )
278+ initAdminServerSocket AppConfig {.. } =
279+ traverse (`bindPortTCP` adminHost) configAdminServerPort
280+ where
281+ adminHost = fromString $ T. unpack configAdminServerHost
282+
0 commit comments