Add --host option to yesod devel (fixes #975)

yesod-bin/ChangeLog.md

@@ -1,3 +1,7 @@
+## 1.5.1
+
+* Add `--host` option to `yesod devel`
+
 ## 1.5.0.1
 
 * Fix build failure

yesod-bin/Devel.hs

@@ -44,8 +44,8 @@ import qualified Network.Socket
 import           Network.Wai                           (requestHeaderHost,
                                                         requestHeaders,
                                                         responseLBS)
-import           Network.Wai.Handler.Warp              (defaultSettings, run,
-                                                        setPort)
+import           Network.Wai.Handler.Warp              (defaultSettings, runSettings,
+                                                        setPort, setHost)
 import           Network.Wai.Handler.WarpTLS           (runTLS,
                                                         tlsSettingsMemory)
 import           Network.Wai.Parse                     (parseHttpAccept)
@@ -115,6 +115,7 @@ data DevelOpts = DevelOpts
       , develTlsPort    :: Int
       , proxyTimeout    :: Int
       , useReverseProxy :: Bool
+      , develHost       :: Maybe String
       } deriving (Show, Eq)
 
 -- | Run a reverse proxy from the develPort and develTlsPort ports to
@@ -151,11 +152,12 @@ reverseProxy opts appPortVar = do
                             else Just (1000000 * proxyTimeout opts)
                     }
                 manager
+        defaultSettings' = maybe id (setHost . fromString) (develHost opts) defaultSettings
         runProxyTls port app = do
           let cert = $(embedFile "certificate.pem")
               key = $(embedFile "key.pem")
               tlsSettings = tlsSettingsMemory cert key
-          runTLS tlsSettings (setPort port defaultSettings) $ \req send -> do
+          runTLS tlsSettings (setPort port defaultSettings') $ \req send -> do
             let req' = req
                     { requestHeaders
                         = ("X-Forwarded-Proto", "https")
@@ -173,7 +175,7 @@ reverseProxy opts appPortVar = do
                           (requestHeaders req)
                     }
             app req' send
-        httpProxy = run (develPort opts) proxyApp
+        httpProxy = runSettings (setPort (develPort opts) defaultSettings') proxyApp
         httpsProxy = runProxyTls (develTlsPort opts) proxyApp
     say "Application can be accessed at:\n"
     sayString $ "http://localhost:" ++ show (develPort opts)

yesod-bin/main.hs

@@ -54,6 +54,7 @@ data Command = Init [String]
                      , develTlsPort     :: Int
                      , proxyTimeout     :: Int
                      , noReverseProxy   :: Bool
+                     , develHost        :: Maybe String
                      }
              | DevelSignal
              | Test
@@ -108,6 +109,7 @@ main = do
                              , develTlsPort = develTlsPort
                              , proxyTimeout = proxyTimeout
                              , useReverseProxy = not noReverseProxy
+                             , develHost    = develHost
                              } develExtraArgs
     DevelSignal     -> develSignal
   where
@@ -189,6 +191,8 @@ develOptions = Devel <$> optStr ( long "success-hook" <> short 's' <> metavar "C
                             <> 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" )
+                     <*> optStr (long "host" <> metavar "HOST"
+                            <> help "Host interface to bind to; IP address, '*' for all interfaces, '*4' for IP4, '*6' for IP6")
 
 extraStackArgs :: Parser [String]
 extraStackArgs = many (strOption ( long "extra-stack-arg" <> short 'e' <> metavar "ARG"

yesod-bin/yesod-bin.cabal

@@ -1,5 +1,5 @@
 name:            yesod-bin
-version:         1.5.0.1
+version:         1.5.1
 license:         MIT
 license-file:    LICENSE
 author:          Michael Snoyman <michael@snoyman.com>