From f9be0a83bd6bcf1b2d02bba58cf5706278b49df7 Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@snoyman.com>
Date: Mon, 10 Jun 2013 11:16:52 +0300
Subject: [PATCH] Option to disable reverse proxy

---
 yesod-bin/Devel.hs | 21 +++++++++++++--------
 yesod-bin/main.hs  |  5 ++++-
 2 files changed, 17 insertions(+), 9 deletions(-)

diff --git a/yesod-bin/Devel.hs b/yesod-bin/Devel.hs
index d4cfafab..bc51c8f9 100644
--- a/yesod-bin/Devel.hs
+++ b/yesod-bin/Devel.hs
@@ -102,13 +102,14 @@ data DevelOpts = DevelOpts
       , buildDir     :: Maybe String
       , develPort    :: Int
       , proxyTimeout :: Int
+      , useReverseProxy :: Bool
       } deriving (Show, Eq)
 
 getBuildDir :: DevelOpts -> String
 getBuildDir opts = fromMaybe "dist" (buildDir opts)
 
 defaultDevelOpts :: DevelOpts
-defaultDevelOpts = DevelOpts False False False (-1) Nothing Nothing Nothing 3000 10
+defaultDevelOpts = DevelOpts False False False (-1) Nothing Nothing Nothing 3000 10 True
 
 cabalProgram :: DevelOpts -> FilePath
 cabalProgram opts | isCabalDev opts = "cabal-dev"
@@ -159,17 +160,21 @@ checkPort p = do
             sClose s
             return True
 
-getPort :: Int -> IO Int
-getPort p = do
-    avail <- checkPort p
-    if avail then return p else getPort (succ p)
+getPort :: DevelOpts -> Int -> IO Int
+getPort opts _ | not (useReverseProxy opts) = return $ develPort opts
+getPort _ p0 =
+    loop p0
+  where
+    loop p = do
+        avail <- checkPort p
+        if avail then return p else loop (succ p)
 
 devel :: DevelOpts -> [String] -> IO ()
 devel opts passThroughArgs = withSocketsDo $ withManager $ \manager -> do
     avail <- checkPort $ develPort opts
     unless avail $ error "devel port unavailable"
-    iappPort <- getPort 17834 >>= I.newIORef
-    _ <- forkIO $ reverseProxy opts iappPort
+    iappPort <- getPort opts 17834 >>= I.newIORef
+    when (useReverseProxy opts) $ void $ forkIO $ reverseProxy opts iappPort
     checkDevelFile
     writeLock opts
 
@@ -233,7 +238,7 @@ devel opts passThroughArgs = withSocketsDo $ withManager $ \manager -> do
                    env0 <- liftIO getEnvironment
 
                    -- get a new port for the new process to listen on
-                   appPort <- liftIO $ I.readIORef iappPort >>= getPort . (+ 1)
+                   appPort <- liftIO $ I.readIORef iappPort >>= getPort opts . (+ 1)
                    liftIO $ I.writeIORef iappPort appPort
 
                    (_,_,_,ph) <- liftIO $ createProcess (proc "runghc" devArgs)
diff --git a/yesod-bin/main.hs b/yesod-bin/main.hs
index df72e2a1..11d6ead3 100755
--- a/yesod-bin/main.hs
+++ b/yesod-bin/main.hs
@@ -55,6 +55,7 @@ data Command = Init
                      , develExtraArgs    :: [String]
                      , _develPort        :: Int
                      , _proxyTimeout     :: Int
+                     , _noReverseProxy   :: Bool
                      }
              | Test
              | AddHandler
@@ -92,7 +93,7 @@ main = do
     Configure               -> cabal ["configure"]
     Build es                -> touch' >> cabal ("build":es)
     Touch                   -> touch'
-    Devel da s f r b _ig es p t -> devel (DevelOpts (optCabalPgm o == CabalDev) da (optVerbose o) r s f b p t) es
+    Devel da s f r b _ig es p t nrp -> devel (DevelOpts (optCabalPgm o == CabalDev) da (optVerbose o) r s f b p t (not nrp)) es
     Keter noRebuild         -> keter (cabalCommand o) noRebuild
     Version                 -> do putStrLn ("yesod-bin version: " ++ showVersion Paths_yesod_bin.version)
     AddHandler              -> addHandler
@@ -150,6 +151,8 @@ develOptions = Devel <$> switch ( long "disable-api"  <> short 'd'
                             <> help "Devel server listening port" )
                      <*> option ( long "proxy-timeout" <> short 'x' <> value 0 <> metavar "N"
                             <> help "Devel server timeout before returning 'not ready' message (in seconds, 0 for none)" )
+                     <*> switch ( long "disable-reverse-proxy" <> short 'n'
+                            <> help "Disable reverse proxy" )
 
 extraCabalArgs :: Parser [String]
 extraCabalArgs = many (strOption ( long "extra-cabal-arg" <> short 'e' <> metavar "ARG"