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

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

Browse Source
This commit is contained in:
Michael Snoyman 2016-12-21 14:27:52 +02:00
parent 9dbbe030de
commit 705b52f7eb
4 changed files with 15 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
yesod-bin/ChangeLog.md
View File

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

10
yesod-bin/Devel.hs
View File

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

4
yesod-bin/main.hs
View File

@ -54,6 +54,7 @@ data Command = Init [String]
, develTlsPort :: Int , develTlsPort :: Int
, proxyTimeout :: Int , proxyTimeout :: Int
, noReverseProxy :: Bool , noReverseProxy :: Bool
, develHost :: Maybe String
} }
| DevelSignal | DevelSignal
| Test | Test
@ -108,6 +109,7 @@ main = do
, develTlsPort = develTlsPort , develTlsPort = develTlsPort
, proxyTimeout = proxyTimeout , proxyTimeout = proxyTimeout
, useReverseProxy = not noReverseProxy , useReverseProxy = not noReverseProxy
, develHost = develHost
} develExtraArgs } develExtraArgs
DevelSignal -> develSignal DevelSignal -> develSignal
where 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)" ) <> help "Devel server timeout before returning 'not ready' message (in seconds, 0 for none)" )
<*> switch ( long "disable-reverse-proxy" <> short 'n' <*> switch ( long "disable-reverse-proxy" <> short 'n'
<> help "Disable reverse proxy" ) <> 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 :: Parser [String]
extraStackArgs = many (strOption ( long "extra-stack-arg" <> short 'e' <> metavar "ARG" extraStackArgs = many (strOption ( long "extra-stack-arg" <> short 'e' <> metavar "ARG"

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

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