From 9f72790df9b3b930cdbee912caa012e8a7beaaab Mon Sep 17 00:00:00 2001
From: James Burton <jamesejburton@gmail.com>
Date: Mon, 8 Feb 2021 17:59:49 +0000
Subject: [PATCH] Added options to pass SSL certificate and key to yesod devel

---
 yesod-bin/Devel.hs | 15 ++++++++++-----
 yesod-bin/main.hs  | 10 +++++++++-
 2 files changed, 19 insertions(+), 6 deletions(-)

diff --git a/yesod-bin/Devel.hs b/yesod-bin/Devel.hs
index 901616f8..bb8d6c11 100644
--- a/yesod-bin/Devel.hs
+++ b/yesod-bin/Devel.hs
@@ -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")
diff --git a/yesod-bin/main.hs b/yesod-bin/main.hs
index 3f3a071b..3cc1b2a9 100755
--- a/yesod-bin/main.hs
+++ b/yesod-bin/main.hs
@@ -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"