haskell/yesod
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Used race_ for clarity

Browse Source
This commit is contained in:
Dan Burton 2015-03-30 13:10:02 -07:00
parent 6562e6067c
commit 85f16d0e9f
2 changed files with 9 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
yesod-bin/Devel.hs
View File

@ -22,6 +22,7 @@ import Control.Applicative ((<$>), (<*>))
import Control.Concurrent (forkIO, threadDelay) import Control.Concurrent (forkIO, threadDelay)
import Control.Concurrent.MVar (MVar, newEmptyMVar, import Control.Concurrent.MVar (MVar, newEmptyMVar,
takeMVar, tryPutMVar) takeMVar, tryPutMVar)
import Control.Concurrent.Async (race_)
import qualified Control.Exception as Ex import qualified Control.Exception as Ex
import Control.Monad (forever, unless, void, import Control.Monad (forever, unless, void,
when, forM) when, forM)
@ -180,14 +181,15 @@ reverseProxy opts iappPort = do
key = $(embedFile "key.pem") key = $(embedFile "key.pem")
tlsSettings = tlsSettingsMemory cert key tlsSettings = tlsSettingsMemory cert key
runTLS tlsSettings (setPort port defaultSettings) app runTLS tlsSettings (setPort port defaultSettings) app
_ <- forkIO $ loop "https" (runProxyTls (develTlsPort opts) proxyApp) `Ex.onException` exitFailure httpProxy = run (develPort opts) proxyApp
loop "http" (run (develPort opts) proxyApp) `Ex.onException` exitFailure httpsProxy = runProxyTls (develTlsPort opts) proxyApp
loop (race_ httpProxy httpsProxy) `Ex.onException` exitFailure
where where
loop label proxy = forever $ do loop proxies = forever $ do
void proxy void proxies
putStrLn $ "Reverse proxy stopped, but it shouldn't: " ++ label putStrLn $ "Reverse proxy stopped, but it shouldn't"
threadDelay 1000000 threadDelay 1000000
putStrLn $ "Restarting reverse proxy: " ++ label putStrLn $ "Restarting reverse proxies"
checkPort :: Int -> IO Bool checkPort :: Int -> IO Bool
checkPort p = do checkPort p = do

1
yesod-bin/yesod-bin.cabal
View File

@ -89,6 +89,7 @@ executable yesod
, data-default-class , data-default-class
, streaming-commons , streaming-commons
, warp-tls , warp-tls
, async
ghc-options: -Wall -threaded -rtsopts ghc-options: -Wall -threaded -rtsopts
main-is: main.hs main-is: main.hs