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

Merge pull request #1717 from Burtannia/devel-ssl

Browse Source 
Devel SSL
This commit is contained in:
Michael Snoyman 2021-02-10 17:46:18 +02:00 committed by GitHub
commit cf8147f37e
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
4 changed files with 21 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
yesod-bin/ChangeLog.md
View File

@ -1,5 +1,9 @@
# ChangeLog for yesod-bin # ChangeLog for yesod-bin
## 1.6.1
Added command line options `cert` and `key` to allow TLS certificate and key files to be passed to `yesod devel` [#1717](https://github.com/yesodweb/yesod/pull/1717)
## 1.6.0.6 ## 1.6.0.6
Fix the `add-handler` subcommand to support both the old default routes filename (`routes`) and the new one (`routes.yesodroutes`) [#1688](https://github.com/yesodweb/yesod/pull/1688) Fix the `add-handler` subcommand to support both the old default routes filename (`routes`) and the new one (`routes.yesodroutes`) [#1688](https://github.com/yesodweb/yesod/pull/1688)

13
yesod-bin/Devel.hs
View File

@ -56,7 +56,7 @@ import Network.Wai (requestHeaderHost,
responseLBS) responseLBS)
import Network.Wai.Handler.Warp (defaultSettings, runSettings, import Network.Wai.Handler.Warp (defaultSettings, runSettings,
setPort, setHost) setPort, setHost)
import Network.Wai.Handler.WarpTLS (runTLS, import Network.Wai.Handler.WarpTLS (runTLS, tlsSettings,
tlsSettingsMemory) tlsSettingsMemory)
import Network.Wai.Parse (parseHttpAccept) import Network.Wai.Parse (parseHttpAccept)
import Say import Say
@ -126,6 +126,7 @@ data DevelOpts = DevelOpts
, proxyTimeout :: Int , proxyTimeout :: Int
, useReverseProxy :: Bool , useReverseProxy :: Bool
, develHost :: Maybe String , develHost :: Maybe String
, cert :: Maybe (FilePath, FilePath)
} 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
@ -170,10 +171,12 @@ reverseProxy opts appPortVar = do
manager manager
defaultSettings' = maybe id (setHost . fromString) (develHost opts) defaultSettings defaultSettings' = maybe id (setHost . fromString) (develHost opts) defaultSettings
runProxyTls port app = do runProxyTls port app = do
let cert = $(embedFile "certificate.pem") let certDef = $(embedFile "certificate.pem")
key = $(embedFile "key.pem") keyDef = $(embedFile "key.pem")
tlsSettings = tlsSettingsMemory cert key theSettings = case cert opts of
runTLS tlsSettings (setPort port defaultSettings') $ \req send -> do Nothing -> tlsSettingsMemory certDef keyDef
Just (c,k) -> tlsSettings c k
runTLS theSettings (setPort port defaultSettings') $ \req send -> do
let req' = req let req' = req
{ requestHeaders { requestHeaders
= ("X-Forwarded-Proto", "https") = ("X-Forwarded-Proto", "https")

9
yesod-bin/main.hs
View File

@ -30,12 +30,13 @@ data Command = Init [String]
| Build { buildExtraArgs :: [String] } | Build { buildExtraArgs :: [String] }
| Touch | Touch
| Devel { develSuccessHook :: Maybe String | Devel { develSuccessHook :: Maybe String
, develExtraArgs :: [String] , develExtraArgs :: [String]
, develPort :: Int , develPort :: Int
, develTlsPort :: Int , develTlsPort :: Int
, proxyTimeout :: Int , proxyTimeout :: Int
, noReverseProxy :: Bool , noReverseProxy :: Bool
, develHost :: Maybe String , develHost :: Maybe String
, cert :: Maybe (FilePath, FilePath)
} }
| DevelSignal | DevelSignal
| Test | Test
@ -90,6 +91,7 @@ main = do
, proxyTimeout = proxyTimeout , proxyTimeout = proxyTimeout
, useReverseProxy = not noReverseProxy , useReverseProxy = not noReverseProxy
, develHost = develHost , develHost = develHost
, cert = cert
} develExtraArgs } develExtraArgs
DevelSignal -> develSignal DevelSignal -> develSignal
where where
@ -167,6 +169,11 @@ develOptions = Devel <$> optStr ( long "success-hook" <> short 's' <> metavar "C
<> help "Disable reverse proxy" ) <> help "Disable reverse proxy" )
<*> optStr (long "host" <> metavar "HOST" <*> optStr (long "host" <> metavar "HOST"
<> help "Host interface to bind to; IP address, '*' for all interfaces, '*4' for IP4, '*6' for IP6") <> help "Host interface to bind to; IP address, '*' for all interfaces, '*4' for IP4, '*6' for IP6")
<*> optional ( (,)
<$> strOption (long "cert" <> metavar "CERT"
<> help "Path to TLS certificate file, requires that --key is also defined")
<*> strOption (long "key" <> metavar "KEY"
<> help "Path to TLS key file, requires that --cert is also defined") )
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.6.0.6 version: 1.6.1
license: MIT license: MIT
license-file: LICENSE license-file: LICENSE
author: Michael Snoyman <michael@snoyman.com> author: Michael Snoyman <michael@snoyman.com>