How do I shut down `runTCPServer`? - haskell

Question

I'm writing a socket server with runTCPServer from conduit-extra (formerly known as network-conduit). My goal is to interact with my editor using this server --- activate the server from the editor (most likely just by calling external command), use it, and terminate the server when the work is done.
For simplicity, I start with a simple echo server, and let's say I'd like to shut down the whole process when the connection is closed.
So I tried:
{-# LANGUAGE OverloadedStrings #-}
module Main where
import Data.Conduit
import Data.Conduit.Network
import Data.ByteString (ByteString)
import Control.Monad.IO.Class (liftIO)
import System.Exit (exitSuccess)
import Control.Exception
defaultPort :: Int
defaultPort = 4567
main :: IO ()
main = runTCPServer (serverSettings defaultPort "*") $ \ appData ->
appSource appData $$ conduit =$= appSink appData
conduit :: ConduitM ByteString ByteString IO ()
conduit = do
msg <- await
case msg of
Nothing -> liftIO $ do
putStrLn "Nothing left"
exitSuccess
-- I'd like the server to shut down here
(Just s) -> do
yield s
conduit
But this doesn't work -- the program continues to accept new connections. If I am not mistaken, this is because the thread listening to the connection we're dealing with exits with exitSuccess, but the entire process doesn't. So this is totally understandable, but I haven't been able to find a way to exit the whole process.
How do I terminate a server run by runTCPServer? Is runTCPServer something that's supposed to serve forever?

Answer 1

Here's a simple implementation of the idea described in comments:
main = do
mv <- newEmptyMVar
tid <- forkTCPServer (serverSettings defaultPort "*") $ \ appData ->
appSource appData $$ conduit mv =$= appSink appData
() <- takeMVar mv -- < -- wait for done signal
return ()
conduit :: MVar () -> ConduitM ByteString ByteString IO ()
conduit mv = do
msg <- await
case msg of
Nothing -> liftIO $ do
putStrLn "Nothing left"
putMVar mv () -- < -- signal that we're done
(Just s) -> do
yield s
conduit mv