make serverLoop blocking again (#59)

This commit is contained in:
Connor Clark 2016-07-27 16:50:48 -07:00
parent 0d70a6c960
commit 5a23c9ae90

View File

@ -9,6 +9,7 @@
module Network.GRPC.HighLevel.Server.Unregistered where module Network.GRPC.HighLevel.Server.Unregistered where
import Control.Concurrent import Control.Concurrent
import Control.Concurrent.Async (async, wait)
import Control.Arrow import Control.Arrow
import qualified Control.Exception as CE import qualified Control.Exception as CE
import Control.Monad import Control.Monad
@ -81,10 +82,10 @@ dispatchLoop server meta hN hC hS hB =
U.serverRW server call meta (convertServerRWHandler h) U.serverRW server call meta (convertServerRWHandler h)
serverLoop :: ServerOptions -> IO () serverLoop :: ServerOptions -> IO ()
serverLoop ServerOptions{..} = serverLoop ServerOptions{..} = do
-- We run the loop in a new thread so that we can kill the serverLoop thread. -- We run the loop in a new thread so that we can kill the serverLoop thread.
-- Without this fork, we block on a foreign call, which can't be interrupted. -- Without this fork, we block on a foreign call, which can't be interrupted.
void $ forkIO $ withGRPC $ \grpc -> tid <- async $ withGRPC $ \grpc ->
withServer grpc config $ \server -> do withServer grpc config $ \server -> do
dispatchLoop server dispatchLoop server
optInitialMetadata optInitialMetadata
@ -92,6 +93,7 @@ serverLoop ServerOptions{..} =
optClientStreamHandlers optClientStreamHandlers
optServerStreamHandlers optServerStreamHandlers
optBiDiStreamHandlers optBiDiStreamHandlers
wait tid
where where
config = config =
ServerConfig ServerConfig