Fixing a race condition in yesod development serverApril 28, 2017
In our work place, we use yesod as development server for our web application. The
yesod executable has two modes of operations:
- Compile mode: It shows a refreshing page indicating that the application is getting compiled.
- App mode: Shows the actual web application
The way it works is this:
- A http/htpps server is run concurrently on two ports.
- Stack build process is run concurrently for building the application.
- The web app is run concurrently and is reverse proxied to the running http/https server.
All the threads running above is synchronized properly via usage of STM. But there was a race condition in the code which always made the development server in compile mode. After lot of instrumentation, I found out that the reason behind that was this piece of code:
The Stack build process was emitting out lines even after the build was successful which again lead to overwriting of the port variable with
-1. This lead it to compile mode again. Pressing Return key and re-building it again made the entire thing work but that was something I have to guess every now and then.
My initial proposed solution was to simply call the above function only when
ExitFailure is emitted. But unfortunately that simple solution won’t work in all cases. After lot of tinkering, I came up with an
MVar based solution which worked good enough:
data BuildOutput = Started deriving (Show, Eq, Ord) makeEmptyMVar :: MVar a -> IO () makeEmptyMVar mvar = do isEmpty <- isEmptyMVar mvar case isEmpty of True -> return () False -> takeMVar mvar >> return () updateAppPort :: ByteString -> MVar (BuildOutput) -> TVar Int -> IO () updateAppPort bs mvar appPortVar = do isEmpty <- isEmptyMVar mvar let hasEnd = isInfixOf stackFailureString bs || isInfixOf stackSuccessString bs case (isEmpty,hasEnd) of (True,False) -> do putMVar mvar Started atomically $ writeTVar appPortVar (-1 :: Int) (_,False) -> return () (_,True) -> makeEmptyMVar mvar
The main idea is to make the port invalid during the start of the Stack build process and then don’t do any further writing on the
TVar variable. When the Stack build process completes, I again make sure that it has the ability to write to the
TVar variable. The ability to when to write to the
TVar is controlled via the locking primitive of
After a series of iteration with Michael, we changed it to a complete STM based solution:
updateAppPort :: ByteString -> TVar Bool -- ^ Bool to indicate if -- output from stack has -- started. False indicate -- that it hasn't started -- yet. -> TVar Int -> STM () updateAppPort bs buildStarted appPortVar = do hasStarted <- readTVar buildStarted let buildEnd = isInfixOf stackFailureString bs || isInfixOf stackSuccessString bs case (hasStarted, buildEnd) of (False, False) -> do writeTVar appPortVar (-1 :: Int) writeTVar buildStarted True (True, False) -> return () (_, True) -> writeTVar buildStarted False
I merged the PR yesterday. Be ready to have a race free experience in yesod devel! :-)