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

Add a second reverse proxy for tls

Browse Source
This commit is contained in:
Dan Burton 2015-03-26 13:41:50 -07:00
parent 56d4b8c3ee
commit 2e573f440a
2 changed files with 40 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
yesod-bin/Devel.hs
View File

@ -108,6 +108,7 @@ data DevelOpts = DevelOpts
, failHook :: Maybe String
, buildDir :: Maybe String
, develPort :: Int
, develTlsPort :: Int
, proxyTimeout :: Int
, useReverseProxy :: Bool
, terminateWith :: DevelTermOpt
@ -117,7 +118,20 @@ getBuildDir :: DevelOpts -> String
getBuildDir opts = fromMaybe "dist" (buildDir opts)
defaultDevelOpts :: DevelOpts
defaultDevelOpts = DevelOpts False False False (-1) Nothing Nothing Nothing 3000 10 True TerminateOnEnter
defaultDevelOpts = DevelOpts
{ isCabalDev = False
, forceCabal = False
, verbose = False
, eventTimeout = -1
, successHook = Nothing
, failHook = Nothing
, buildDir = Nothing
, develPort = 3000
, develTlsPort = 3443
, proxyTimeout = 10
, useReverseProxy = True
, terminateWith = TerminateOnEnter
}
cabalProgram :: DevelOpts -> FilePath
cabalProgram opts | isCabalDev opts = "cabal-dev"
@ -146,8 +160,8 @@ reverseProxy opts iappPort = do
]
refreshHtml
let runProxy =
run (develPort opts) $ waiProxyToSettings
let runProxy port =
run port $ waiProxyToSettings
(const $ do
appPort <- liftIO $ I.readIORef iappPort
return $
@ -161,13 +175,14 @@ reverseProxy opts iappPort = do
else Just (1000000 * proxyTimeout opts)
}
manager
loop runProxy `Ex.onException` exitFailure
_ <- forkIO $ loop "https" (runProxy $ develTlsPort opts) `Ex.onException` exitFailure
loop "http" (runProxy $ develPort opts) `Ex.onException` exitFailure
where
loop proxy = forever $ do
loop label proxy = forever $ do
void proxy
putStrLn "Reverse proxy stopped, but it shouldn't"
putStrLn $ "Reverse proxy stopped, but it shouldn't: " ++ label
threadDelay 1000000
putStrLn "Restarting reverse proxy"
putStrLn $ "Restarting reverse proxy: " ++ label
checkPort :: Int -> IO Bool
checkPort p = do

25
yesod-bin/main.hs
View File

@ -54,6 +54,7 @@ data Command = Init { _initBare :: Bool }
, develIgnore :: [String]
, develExtraArgs :: [String]
, _develPort :: Int
, _develTlsPort :: Int
, _proxyTimeout :: Int
, _noReverseProxy :: Bool
, _interruptOnly :: Bool
@ -107,13 +108,21 @@ main = do
Version -> putStrLn ("yesod-bin version: " ++ showVersion Paths_yesod_bin.version)
AddHandler{..} -> addHandler addHandlerRoute addHandlerPattern addHandlerMethods
Test -> cabalTest cabal
Devel{..} -> devel (DevelOpts
(optCabalPgm o == CabalDev) _develDisableApi (optVerbose o)
_develRescan _develSuccessHook _develFailHook
_develBuildDir _develPort _proxyTimeout
(not _noReverseProxy)
(if _interruptOnly then TerminateOnlyInterrupt else TerminateOnEnter )
) develExtraArgs
Devel{..} -> let develOpts = DevelOpts
{ isCabalDev = optCabalPgm o == CabalDev
, forceCabal = _develDisableApi
, verbose = optVerbose o
, eventTimeout = _develRescan
, successHook = _develSuccessHook
, failHook = _develFailHook
, buildDir = _develBuildDir
, develPort = _develPort
, develTlsPort = _develTlsPort
, proxyTimeout = _proxyTimeout
, useReverseProxy = not _noReverseProxy
, terminateWith = if _interruptOnly then TerminateOnlyInterrupt else TerminateOnEnter
}
in devel develOpts develExtraArgs
where
cabalTest cabal = do touch'
_ <- cabal ["configure", "--enable-tests", "-flibrary-only"]
@ -178,6 +187,8 @@ develOptions = Devel <$> switch ( long "disable-api" <> short 'd'
<*> extraCabalArgs
<*> option auto ( long "port" <> short 'p' <> value 3000 <> metavar "N"
<> help "Devel server listening port" )
<*> option auto ( long "tls-port" <> short 'q' <> value 3443 <> metavar "N"
<> help "Devel server listening port (tls)" )
<*> option auto ( 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'