From 878534a272e06fb65ea44a86a7558d6f07c9cfcf Mon Sep 17 00:00:00 2001 From: Sibi Prabakaran Date: Thu, 20 Apr 2017 18:52:20 +0530 Subject: [PATCH 01/10] Fix race condition in yesod-bin Stack build process emittles line even after successful build process which leads to the overwriting of the appPortVar with -1. This leads it to a compile mode again. Pressing Return Key and rebuilding it again makes it go, but that's just a workaround I have to do every now and then to solve the actual issue. I'm using a `MVar` based locking solution for fixing the race condition introduced. --- yesod-bin/Devel.hs | 37 +++++++++++++++++++++++++++++++++++-- yesod-bin/yesod-bin.cabal | 2 +- 2 files changed, 36 insertions(+), 3 deletions(-) diff --git a/yesod-bin/Devel.hs b/yesod-bin/Devel.hs index 4289317b..b477557c 100644 --- a/yesod-bin/Devel.hs +++ b/yesod-bin/Devel.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} @@ -11,9 +12,12 @@ import Control.Applicative ((<|>)) import Control.Concurrent (threadDelay) import Control.Concurrent.Async (race_) import Control.Concurrent.STM +import Control.Concurrent.MVar +import System.IO import qualified Control.Exception.Safe as Ex import Control.Monad (forever, unless, void, when) +import Data.ByteString (ByteString, isInfixOf) import qualified Data.ByteString.Lazy as LB import Data.Conduit (($$), (=$)) import qualified Data.Conduit.Binary as CB @@ -222,6 +226,33 @@ checkDevelFile = then return x else loop xs +stackSuccessString :: ByteString +stackSuccessString = "ExitSuccess" + +stackFailureString :: ByteString +stackFailureString = "ExitFailure" + +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 + -- | Get the set of all flags available in the given cabal file getAvailableFlags :: D.GenericPackageDescription -> Set.Set String getAvailableFlags = @@ -283,6 +314,7 @@ devel opts passThroughArgs = do sayV = when (verbose opts) . sayString -- Leverage "stack build --file-watch" to do the build + runStackBuild :: TVar Int -> [Char] -> Set.Set [Char] -> IO () runStackBuild appPortVar packageName availableFlags = do -- We call into this app for the devel-signal command myPath <- getExecutablePath @@ -316,7 +348,7 @@ devel opts passThroughArgs = do passThroughArgs sayV $ show procConfig - + mvar <- newEmptyMVar -- Monitor the stdout and stderr content from the build process. Any -- time some output comes, we invalidate the currently running app by -- changing the destination port for reverse proxying to -1. We also @@ -325,12 +357,13 @@ devel opts passThroughArgs = do withProcess_ procConfig $ \p -> do let helper getter h = getter p - $$ CL.iterM (\_ -> atomically $ writeTVar appPortVar (-1)) + $$ CL.iterM (\(str :: ByteString) -> updateAppPort str mvar appPortVar) =$ CB.sinkHandle h race_ (helper getStdout stdout) (helper getStderr stderr) -- Run the inner action with a TVar which will be set to True -- whenever the signal file is modified. + withChangedVar :: (TVar Bool -> IO a) -> IO a withChangedVar inner = withManager $ \manager -> do -- Variable indicating that the signal file has been changed. We -- reset it each time we handle the signal. diff --git a/yesod-bin/yesod-bin.cabal b/yesod-bin/yesod-bin.cabal index 54eb1805..31f42fb6 100644 --- a/yesod-bin/yesod-bin.cabal +++ b/yesod-bin/yesod-bin.cabal @@ -1,5 +1,5 @@ name: yesod-bin -version: 1.5.2.2 +version: 1.7 license: MIT license-file: LICENSE author: Michael Snoyman From c37283e300fd21374bfc3901ce1a2bf666667959 Mon Sep 17 00:00:00 2001 From: Sibi Prabakaran Date: Mon, 24 Apr 2017 20:39:20 +0530 Subject: [PATCH 02/10] Update Changelog and do version bump --- yesod-bin/ChangeLog.md | 4 ++++ yesod-bin/yesod-bin.cabal | 2 +- 2 files changed, 5 insertions(+), 1 deletion(-) diff --git a/yesod-bin/ChangeLog.md b/yesod-bin/ChangeLog.md index 9a8c6990..2ffb0332 100644 --- a/yesod-bin/ChangeLog.md +++ b/yesod-bin/ChangeLog.md @@ -1,3 +1,7 @@ +## 1.5.2.3 + +* Fix race condition which leads dev server to stay in compilation mode. [#1380](https://github.com/yesodweb/yesod/issues/1380) + ## 1.5.2.2 * I guess `--no-nix-pure` implies Nix... sigh [#1359](https://github.com/yesodweb/yesod/issues/1359) diff --git a/yesod-bin/yesod-bin.cabal b/yesod-bin/yesod-bin.cabal index 31f42fb6..67d6392f 100644 --- a/yesod-bin/yesod-bin.cabal +++ b/yesod-bin/yesod-bin.cabal @@ -1,5 +1,5 @@ name: yesod-bin -version: 1.7 +version: 1.5.2.3 license: MIT license-file: LICENSE author: Michael Snoyman From 62d7a19149783f47ca8e392c216acaefc386d76a Mon Sep 17 00:00:00 2001 From: Sibi Prabakaran Date: Mon, 24 Apr 2017 21:51:13 +0530 Subject: [PATCH 03/10] Fix warnings --- yesod-bin/Devel.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/yesod-bin/Devel.hs b/yesod-bin/Devel.hs index b477557c..b7c0de28 100644 --- a/yesod-bin/Devel.hs +++ b/yesod-bin/Devel.hs @@ -13,7 +13,6 @@ import Control.Concurrent (threadDelay) import Control.Concurrent.Async (race_) import Control.Concurrent.STM import Control.Concurrent.MVar -import System.IO import qualified Control.Exception.Safe as Ex import Control.Monad (forever, unless, void, when) From 706de891562ff9ec70c51a3d536ffb18a2a53c52 Mon Sep 17 00:00:00 2001 From: Sibi Prabakaran Date: Wed, 26 Apr 2017 19:37:59 +0530 Subject: [PATCH 04/10] Change logic to use TVar --- yesod-bin/Devel.hs | 42 ++++++++++++++++++++---------------------- 1 file changed, 20 insertions(+), 22 deletions(-) diff --git a/yesod-bin/Devel.hs b/yesod-bin/Devel.hs index b7c0de28..45cb4239 100644 --- a/yesod-bin/Devel.hs +++ b/yesod-bin/Devel.hs @@ -231,26 +231,24 @@ stackSuccessString = "ExitSuccess" stackFailureString :: ByteString stackFailureString = "ExitFailure" -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 +-- We need updateAppPort logic to prevent a race condition. +-- See https://github.com/yesodweb/yesod/issues/1380 +updateAppPort :: ByteString -> TVar Bool -- ^ Bool to indicate if the + -- output from stack has + -- started. False indicate + -- that it hasn't started + -- yet. + -> TVar Int -> IO () +updateAppPort bs buildStarted appPortVar = do + hasStarted <- readTVarIO buildStarted + let buildEnd = isInfixOf stackFailureString bs || isInfixOf stackSuccessString bs + case (hasStarted, buildEnd) of + (False, False) -> do + atomically $ do + writeTVar appPortVar (-1 :: Int) + writeTVar buildStarted True + (True, False) -> return () + (_, True) -> atomically $ writeTVar buildStarted False -- | Get the set of all flags available in the given cabal file getAvailableFlags :: D.GenericPackageDescription -> Set.Set String @@ -347,7 +345,7 @@ devel opts passThroughArgs = do passThroughArgs sayV $ show procConfig - mvar <- newEmptyMVar + buildStarted <- newTVarIO False -- Monitor the stdout and stderr content from the build process. Any -- time some output comes, we invalidate the currently running app by -- changing the destination port for reverse proxying to -1. We also @@ -356,7 +354,7 @@ devel opts passThroughArgs = do withProcess_ procConfig $ \p -> do let helper getter h = getter p - $$ CL.iterM (\(str :: ByteString) -> updateAppPort str mvar appPortVar) + $$ CL.iterM (\(str :: ByteString) -> updateAppPort str buildStarted appPortVar) =$ CB.sinkHandle h race_ (helper getStdout stdout) (helper getStderr stderr) From 37c9d2599001b5e49635f4eea994524d4e115a61 Mon Sep 17 00:00:00 2001 From: Sibi Prabakaran Date: Wed, 26 Apr 2017 20:56:58 +0530 Subject: [PATCH 05/10] Add Debug flag --- yesod-bin/Devel.hs | 20 +++++++++++++++++--- yesod/yesod.cabal | 2 +- 2 files changed, 18 insertions(+), 4 deletions(-) diff --git a/yesod-bin/Devel.hs b/yesod-bin/Devel.hs index 45cb4239..889f91c8 100644 --- a/yesod-bin/Devel.hs +++ b/yesod-bin/Devel.hs @@ -12,7 +12,6 @@ import Control.Applicative ((<|>)) import Control.Concurrent (threadDelay) import Control.Concurrent.Async (race_) import Control.Concurrent.STM -import Control.Concurrent.MVar import qualified Control.Exception.Safe as Ex import Control.Monad (forever, unless, void, when) @@ -145,6 +144,9 @@ reverseProxy opts appPortVar = do let proxyApp = waiProxyToSettings (const $ do appPort <- atomically $ readTVar appPortVar +#if DEBUG + print $ "revProxy: appPort " ++ (show appPort) +#endif return $ ReverseProxy.WPRProxyDest $ ProxyDest "127.0.0.1" appPort) @@ -244,11 +246,22 @@ updateAppPort bs buildStarted appPortVar = do let buildEnd = isInfixOf stackFailureString bs || isInfixOf stackSuccessString bs case (hasStarted, buildEnd) of (False, False) -> do +#if DEBUG + print "updated appPortVar to -1" +#endif atomically $ do writeTVar appPortVar (-1 :: Int) writeTVar buildStarted True - (True, False) -> return () - (_, True) -> atomically $ writeTVar buildStarted False + (True, False) -> do +#if DEBUG + print "ignored" +#endif + return () + (_, True) -> do +#if DEBUG + print "Reset buildStarted to False" +#endif + atomically $ writeTVar buildStarted False -- | Get the set of all flags available in the given cabal file getAvailableFlags :: D.GenericPackageDescription -> Set.Set String @@ -383,6 +396,7 @@ devel opts passThroughArgs = do inner changedVar -- Each time the library builds successfully, run the application + runApp :: TVar Int -> TVar Bool -> String -> IO b runApp appPortVar changedVar develHsPath = do -- Wait for the first change, indicating that the library -- has been built diff --git a/yesod/yesod.cabal b/yesod/yesod.cabal index fdde1f0e..b804714b 100644 --- a/yesod/yesod.cabal +++ b/yesod/yesod.cabal @@ -1,5 +1,5 @@ name: yesod -version: 1.4.5 +version: 1.4.6 license: MIT license-file: LICENSE author: Michael Snoyman From 35e0095590ad3b372e3772e50b75e16f7062e20b Mon Sep 17 00:00:00 2001 From: Sibi Prabakaran Date: Wed, 26 Apr 2017 20:57:13 +0530 Subject: [PATCH 06/10] Add releavant flag in yesod-bin --- yesod-bin/yesod-bin.cabal | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/yesod-bin/yesod-bin.cabal b/yesod-bin/yesod-bin.cabal index 67d6392f..df53c4e8 100644 --- a/yesod-bin/yesod-bin.cabal +++ b/yesod-bin/yesod-bin.cabal @@ -18,11 +18,17 @@ extra-source-files: refreshing.html *.pem +flag debug + default: False + description: Print debugging info. + executable yesod if os(windows) cpp-options: -DWINDOWS if os(openbsd) ld-options: -Wl,-zwxneeded + if flag(debug) + cpp-options: -DDEBUG build-depends: base >= 4.3 && < 5 , parsec >= 2.1 && < 4 From 67eb728703ea773614b7f2d62bdd3e2236cb9d1f Mon Sep 17 00:00:00 2001 From: Sibi Prabakaran Date: Thu, 27 Apr 2017 17:08:12 +0530 Subject: [PATCH 07/10] Make updateAppPort as a single STM transaction --- yesod-bin/Devel.hs | 31 +++++++++---------------------- 1 file changed, 9 insertions(+), 22 deletions(-) diff --git a/yesod-bin/Devel.hs b/yesod-bin/Devel.hs index 889f91c8..22e6a515 100644 --- a/yesod-bin/Devel.hs +++ b/yesod-bin/Devel.hs @@ -128,6 +128,7 @@ reverseProxy :: DevelOpts -> TVar Int -> IO () reverseProxy opts appPortVar = do manager <- newManager $ managerSetProxy noProxy tlsManagerSettings let refreshHtml = LB.fromChunks [$(embedFile "refreshing.html")] + sayV = when (verbose opts) . sayString let onExc _ req | maybe False (("application/json" `elem`) . parseHttpAccept) (lookup "accept" $ requestHeaders req) = @@ -144,9 +145,7 @@ reverseProxy opts appPortVar = do let proxyApp = waiProxyToSettings (const $ do appPort <- atomically $ readTVar appPortVar -#if DEBUG - print $ "revProxy: appPort " ++ (show appPort) -#endif + sayV $ "revProxy: appPort " ++ (show appPort) return $ ReverseProxy.WPRProxyDest $ ProxyDest "127.0.0.1" appPort) @@ -240,28 +239,16 @@ updateAppPort :: ByteString -> TVar Bool -- ^ Bool to indicate if the -- started. False indicate -- that it hasn't started -- yet. - -> TVar Int -> IO () + -> TVar Int -> STM () updateAppPort bs buildStarted appPortVar = do - hasStarted <- readTVarIO buildStarted + hasStarted <- readTVar buildStarted let buildEnd = isInfixOf stackFailureString bs || isInfixOf stackSuccessString bs case (hasStarted, buildEnd) of (False, False) -> do -#if DEBUG - print "updated appPortVar to -1" -#endif - atomically $ do - writeTVar appPortVar (-1 :: Int) - writeTVar buildStarted True - (True, False) -> do -#if DEBUG - print "ignored" -#endif - return () - (_, True) -> do -#if DEBUG - print "Reset buildStarted to False" -#endif - atomically $ writeTVar buildStarted False + writeTVar appPortVar (-1 :: Int) + writeTVar buildStarted True + (True, False) -> return () + (_, True) -> writeTVar buildStarted False -- | Get the set of all flags available in the given cabal file getAvailableFlags :: D.GenericPackageDescription -> Set.Set String @@ -367,7 +354,7 @@ devel opts passThroughArgs = do withProcess_ procConfig $ \p -> do let helper getter h = getter p - $$ CL.iterM (\(str :: ByteString) -> updateAppPort str buildStarted appPortVar) + $$ CL.iterM (\(str :: ByteString) -> atomically (updateAppPort str buildStarted appPortVar)) =$ CB.sinkHandle h race_ (helper getStdout stdout) (helper getStderr stderr) From 10b5d4f8e267b853669a3e0178a51d85a3187ecb Mon Sep 17 00:00:00 2001 From: Sibi Prabakaran Date: Thu, 27 Apr 2017 17:40:32 +0530 Subject: [PATCH 08/10] Remove debug option --- yesod-bin/yesod-bin.cabal | 4 ---- 1 file changed, 4 deletions(-) diff --git a/yesod-bin/yesod-bin.cabal b/yesod-bin/yesod-bin.cabal index df53c4e8..1560c8b7 100644 --- a/yesod-bin/yesod-bin.cabal +++ b/yesod-bin/yesod-bin.cabal @@ -18,10 +18,6 @@ extra-source-files: refreshing.html *.pem -flag debug - default: False - description: Print debugging info. - executable yesod if os(windows) cpp-options: -DWINDOWS From 3350ca3d9adf13b0c37b638e79443ad0a6bec990 Mon Sep 17 00:00:00 2001 From: Sibi Prabakaran Date: Thu, 27 Apr 2017 17:49:21 +0530 Subject: [PATCH 09/10] Remove flag conditional --- yesod-bin/yesod-bin.cabal | 2 -- 1 file changed, 2 deletions(-) diff --git a/yesod-bin/yesod-bin.cabal b/yesod-bin/yesod-bin.cabal index 1560c8b7..67d6392f 100644 --- a/yesod-bin/yesod-bin.cabal +++ b/yesod-bin/yesod-bin.cabal @@ -23,8 +23,6 @@ executable yesod cpp-options: -DWINDOWS if os(openbsd) ld-options: -Wl,-zwxneeded - if flag(debug) - cpp-options: -DDEBUG build-depends: base >= 4.3 && < 5 , parsec >= 2.1 && < 4 From 5bb5e8948faccbaafc34dd7896e2d885a65b6cb4 Mon Sep 17 00:00:00 2001 From: Sibi Prabakaran Date: Thu, 27 Apr 2017 18:03:39 +0530 Subject: [PATCH 10/10] Revert back yesod version --- yesod/yesod.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/yesod/yesod.cabal b/yesod/yesod.cabal index b804714b..fdde1f0e 100644 --- a/yesod/yesod.cabal +++ b/yesod/yesod.cabal @@ -1,5 +1,5 @@ name: yesod -version: 1.4.6 +version: 1.4.5 license: MIT license-file: LICENSE author: Michael Snoyman