Merge pull request #964 from DanBurton/master
Add support for https on yesod devel
This commit is contained in:
Michael Snoyman
commit
c430bf4a91
@ -22,6 +22,7 @@ import Control.Applicative ((<$>), (<*>))
|
||||
import Control.Concurrent (forkIO, threadDelay)
|
||||
import Control.Concurrent.MVar (MVar, newEmptyMVar,
|
||||
takeMVar, tryPutMVar)
|
||||
import Control.Concurrent.Async (race_)
|
||||
import qualified Control.Exception as Ex
|
||||
import Control.Monad (forever, unless, void,
|
||||
when, forM)
|
||||
@ -78,7 +79,8 @@ import Network.HTTP.Types (status200, status503)
|
||||
import Network.Socket (sClose)
|
||||
import Network.Wai (responseLBS, requestHeaders)
|
||||
import Network.Wai.Parse (parseHttpAccept)
|
||||
import Network.Wai.Handler.Warp (run)
|
||||
import Network.Wai.Handler.Warp (run, defaultSettings, setPort)
|
||||
import Network.Wai.Handler.WarpTLS (runTLS, tlsSettingsMemory)
|
||||
import SrcLoc (Located)
|
||||
import Data.FileEmbed (embedFile)
|
||||
|
||||
@ -108,6 +110,7 @@ data DevelOpts = DevelOpts
|
||||
, failHook :: Maybe String
|
||||
, buildDir :: Maybe String
|
||||
, develPort :: Int
|
||||
, develTlsPort :: Int
|
||||
, proxyTimeout :: Int
|
||||
, useReverseProxy :: Bool
|
||||
, terminateWith :: DevelTermOpt
|
||||
@ -117,7 +120,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 +162,7 @@ reverseProxy opts iappPort = do
|
||||
]
|
||||
refreshHtml
|
||||
|
||||
let runProxy =
|
||||
run (develPort opts) $ waiProxyToSettings
|
||||
let proxyApp = waiProxyToSettings
|
||||
(const $ do
|
||||
appPort <- liftIO $ I.readIORef iappPort
|
||||
return $
|
||||
@ -161,13 +176,20 @@ reverseProxy opts iappPort = do
|
||||
else Just (1000000 * proxyTimeout opts)
|
||||
}
|
||||
manager
|
||||
loop runProxy `Ex.onException` exitFailure
|
||||
runProxyTls port app = do
|
||||
let cert = $(embedFile "certificate.pem")
|
||||
key = $(embedFile "key.pem")
|
||||
tlsSettings = tlsSettingsMemory cert key
|
||||
runTLS tlsSettings (setPort port defaultSettings) app
|
||||
httpProxy = run (develPort opts) proxyApp
|
||||
httpsProxy = runProxyTls (develTlsPort opts) proxyApp
|
||||
loop (race_ httpProxy httpsProxy) `Ex.onException` exitFailure
|
||||
where
|
||||
loop proxy = forever $ do
|
||||
void proxy
|
||||
putStrLn "Reverse proxy stopped, but it shouldn't"
|
||||
loop proxies = forever $ do
|
||||
void proxies
|
||||
putStrLn $ "Reverse proxy stopped, but it shouldn't"
|
||||
threadDelay 1000000
|
||||
putStrLn "Restarting reverse proxy"
|
||||
putStrLn $ "Restarting reverse proxies"
|
||||
|
||||
checkPort :: Int -> IO Bool
|
||||
checkPort p = do
|
||||
|
||||
15
yesod-bin/certificate.pem
Normal file
15
yesod-bin/certificate.pem
Normal file
@ -0,0 +1,15 @@
|
||||
-----BEGIN CERTIFICATE-----
|
||||
MIICWDCCAcGgAwIBAgIJAJG1ZMlcMDW6MA0GCSqGSIb3DQEBBQUAMEUxCzAJBgNV
|
||||
BAYTAkFVMRMwEQYDVQQIDApTb21lLVN0YXRlMSEwHwYDVQQKDBhJbnRlcm5ldCBX
|
||||
aWRnaXRzIFB0eSBMdGQwHhcNMTExMDIyMTk0MjU3WhcNMTExMTIxMTk0MjU3WjBF
|
||||
MQswCQYDVQQGEwJBVTETMBEGA1UECAwKU29tZS1TdGF0ZTEhMB8GA1UECgwYSW50
|
||||
ZXJuZXQgV2lkZ2l0cyBQdHkgTHRkMIGfMA0GCSqGSIb3DQEBAQUAA4GNADCBiQKB
|
||||
gQCfYZx7kV6ybogMyAf9MINm7Rwin5LKh+TpD1ZkbLgmqFVotQCdthgTK66SPXkx
|
||||
EXGI27biNzacJhX7Ml7/4o8sp2GslYKUO46DYvgi/nnNX/bzA5cDJSSGK11eQEVs
|
||||
+p0GEZ/6Juhpx/oQwMDMgo0UHkiH8QtKI8ojXnFF2MsLNwIDAQABo1AwTjAdBgNV
|
||||
HQ4EFgQUaA6FbOj/0VJMb4egNyIDZ/ZNV/YwHwYDVR0jBBgwFoAUaA6FbOj/0VJM
|
||||
b4egNyIDZ/ZNV/YwDAYDVR0TBAUwAwEB/zANBgkqhkiG9w0BAQUFAAOBgQCTQyOk
|
||||
D86Z+yzedXjTLI6FT8QugmQne1YQ8P0w37P76z2reagSvNee2e9B1oTHoPeKZMs0
|
||||
k99oS9yJ/NOQ1Ms90P+q0yBVGxAs/gF65qKgE27YGXzNtNobj/D4OoxcFG+BsORw
|
||||
VvYSBV4FiVy9RwJsr7AMqkUBcOEPCuJHgTx58w==
|
||||
-----END CERTIFICATE-----
|
||||
15
yesod-bin/key.pem
Normal file
15
yesod-bin/key.pem
Normal file
@ -0,0 +1,15 @@
|
||||
-----BEGIN RSA PRIVATE KEY-----
|
||||
MIICXAIBAAKBgQCfYZx7kV6ybogMyAf9MINm7Rwin5LKh+TpD1ZkbLgmqFVotQCd
|
||||
thgTK66SPXkxEXGI27biNzacJhX7Ml7/4o8sp2GslYKUO46DYvgi/nnNX/bzA5cD
|
||||
JSSGK11eQEVs+p0GEZ/6Juhpx/oQwMDMgo0UHkiH8QtKI8ojXnFF2MsLNwIDAQAB
|
||||
AoGAR8pgAgjo7tZ60ccIUjOX/LSxB6d5J2Eu6wvNjk6qZD9OuWtOa7up/HigmZ63
|
||||
CDMjQNI2/o6AOrWtEQkPYZNbibuifzg5V517nHGSqkqjoIgesAiwEsoKpeOgGTtM
|
||||
MM08oHbJ9uOnDnEEnDBiE0iE3jCTDfmwjqDMpUhu9dZ1EAECQQDKVpzSSV3pzMOp
|
||||
ixNxMpYxzcE+4K9jgM+MlxPBJSQhVrg/cRQWb26cKBi8LdSxF23hQTsFr+8qLwid
|
||||
Ah2AgUOBAkEAyaaCjrNRCiHRpd6YzWZ6GKkxbUvxSuOKX3N7hDaE2OFzQTv2Li8B
|
||||
5mrCsXnSZtOG+MBFdHU66UYie1OzDSDKtwJAKMsvkOID0ihbZmpIwDC/wUjHZkLs
|
||||
eXY14hVvgShY0XPnb7r/nspWlZsr6Xyf/hhIKfr5yFrBMFMNPIJ5qjflgQJAWsyV
|
||||
YTgxN4S+6BdxapvIQq58ySA3CGeo+Q4BAimibB4oTal4UpdsHZrZDB00toRs9Dlv
|
||||
jN70pfGkuS+ZIkIvxQJBAKSf5qpXWp4oZcThkieAiMeAhG96xqRPXhPUxq6QF+YG
|
||||
T4PF1sjlpZwqy7C+2oF3BqLP09mCW7YkH9Jgnl1zDF8=
|
||||
-----END RSA PRIVATE KEY-----
|
||||
@ -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'
|
||||
|
||||
@ -17,6 +17,7 @@ extra-source-files:
|
||||
input/*.cg
|
||||
hsfiles/*.hsfiles
|
||||
ChangeLog.md
|
||||
*.pem
|
||||
|
||||
executable yesod-ghc-wrapper
|
||||
main-is: ghcwrapper.hs
|
||||
@ -87,6 +88,8 @@ executable yesod
|
||||
, wai-extra
|
||||
, data-default-class
|
||||
, streaming-commons
|
||||
, warp-tls
|
||||
, async
|
||||
|
||||
ghc-options: -Wall -threaded -rtsopts
|
||||
main-is: main.hs
|
||||
|
||||
Loading…
Reference in New Issue
Block a user