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

Added options to pass SSL certificate and key to yesod devel

Browse Source
This commit is contained in:
James Burton 2021-02-08 17:59:49 +00:00
parent 1c471acfd5
commit 9f72790df9
2 changed files with 19 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
yesod-bin/Devel.hs
View File

@ -9,6 +9,7 @@ module Devel
) where
import Control.Applicative ((<|>))
import Control.Arrow ((&&&))
import UnliftIO (race_)
import Control.Concurrent (threadDelay)
import Control.Concurrent.STM
@ -18,6 +19,7 @@ import Control.Monad (forever, unless, void,
import Data.ByteString (ByteString, isInfixOf)
import qualified Data.ByteString.Lazy as LB
import Conduit
import Data.Bitraversable (bisequence)
import Data.FileEmbed (embedFile)
import qualified Data.Map as Map
import Data.Maybe (isJust)
@ -56,7 +58,7 @@ import Network.Wai (requestHeaderHost,
responseLBS)
import Network.Wai.Handler.Warp (defaultSettings, runSettings,
setPort, setHost)
import Network.Wai.Handler.WarpTLS (runTLS,
import Network.Wai.Handler.WarpTLS (runTLS, tlsSettings,
tlsSettingsMemory)
import Network.Wai.Parse (parseHttpAccept)
import Say
@ -126,6 +128,8 @@ data DevelOpts = DevelOpts
, proxyTimeout :: Int
, useReverseProxy :: Bool
, develHost :: Maybe String
, certPath :: Maybe FilePath
, keyPath :: Maybe FilePath
} deriving (Show, Eq)
-- | Run a reverse proxy from the develPort and develTlsPort ports to
@ -170,10 +174,11 @@ reverseProxy opts appPortVar = do
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
let certDef = $(embedFile "certificate.pem")
keyDef = $(embedFile "key.pem")
certOpts = bisequence $ (certPath &&& keyPath) opts
theSettings = maybe (tlsSettingsMemory certDef keyDef) (uncurry tlsSettings) certOpts
runTLS theSettings (setPort port defaultSettings') $ \req send -> do
let req' = req
{ requestHeaders
= ("X-Forwarded-Proto", "https")

10
yesod-bin/main.hs
View File

@ -30,12 +30,14 @@ data Command = Init [String]
| Build { buildExtraArgs :: [String] }
| Touch
| Devel { develSuccessHook :: Maybe String
, develExtraArgs :: [String]
, develExtraArgs :: [String]
, develPort :: Int
, develTlsPort :: Int
, proxyTimeout :: Int
, noReverseProxy :: Bool
, develHost :: Maybe String
, certPath :: Maybe FilePath
, keyPath :: Maybe FilePath
}
| DevelSignal
| Test
@ -90,6 +92,8 @@ main = do
, proxyTimeout = proxyTimeout
, useReverseProxy = not noReverseProxy
, develHost = develHost
, certPath = certPath
, keyPath = keyPath
} develExtraArgs
DevelSignal -> develSignal
where
@ -167,6 +171,10 @@ develOptions = Devel <$> optStr ( long "success-hook" <> short 's' <> metavar "C
<> 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")
<*> optStr (long "cert" <> metavar "CERT"
<> help "Path to TLS certificate file, does nothing if --key is not also defined")
<*> optStr (long "key" <> metavar "KEY"
<> help "Path to TLS key file, does nothing if --cert is not also defined")
extraStackArgs :: Parser [String]
extraStackArgs = many (strOption ( long "extra-stack-arg" <> short 'e' <> metavar "ARG"