@@ -18,6 +18,7 @@ import Control.Category
1818import Control.Concurrent
1919import Control.Exception
2020import Control.Lens ((%~), (^?), _Just, _Right)
21+import Control.Monad (unless)
2122import qualified Data.Attoparsec.ByteString.Char8 as A
2223import Data.ByteString (ByteString)
2324import qualified Data.ByteString.Char8 as BSC
@@ -35,6 +36,7 @@ import Data.String (fromString)
3536import Data.Text (Text)
3637import qualified Data.Text as T
3738import qualified Data.Text.Encoding as T
39+import Data.Time.Clock (getCurrentTime, addUTCTime)
3840import Language.Javascript.JSaddle.Run (syncPoint)
3941import Language.Javascript.JSaddle.WebSockets
4042import Network.HTTP.Client (Manager, defaultManagerSettings, newManager)
@@ -52,9 +54,13 @@ import qualified Obelisk.Asset.Serve.Snap as Snap
5254import Obelisk.Backend
5355import Obelisk.Frontend
5456import Obelisk.Route.Frontend
57+import qualified OpenSSL.PEM as PEM
58+import qualified OpenSSL.RSA as RSA
59+import qualified OpenSSL.X509 as X509
60+import qualified OpenSSL.X509.Request as X509Request
5561import Reflex.Dom.Core
5662import Snap.Core (Snap)
57−import System.Directory (getXdgDirectory, XdgDirectory(..))
63+import System.Directory (getXdgDirectory, XdgDirectory(..), doesFileExist, createDirectoryIfMissing)
5864import System.Environment
5965import System.IO
6066import System.Process
@@ -110,7 +116,6 @@ runWidget
110116 -> IO ()
111117runWidget conf configs frontend validFullEncoder = do
112118 uri <- either (fail . T.unpack) pure $ getConfigRoute configs
113− userCfg <- getXdgDirectory XdgConfig "obelisk"
114119 let port = fromIntegral $ fromMaybe 80 $ uri ^? uriAuthority . _Right . authPort . _Just
115120 redirectHost = _runConfig_redirectHost conf
116121 redirectPort = _runConfig_redirectPort conf
@@ -118,9 +123,36 @@ runWidget conf configs frontend validFullEncoder = do
118123 putStrLn $ "Frontend running on " <> T.unpack (URI.render uri)
119124 settings = setBeforeMainLoop beforeMainLoop (setPort port (setTimeout 3600 defaultSettings))
120125 -- Providing TLS here will also incidentally provide it to proxied requests to the backend.
121− runner = case (uri ^? uriScheme . _Just . unRText) of
122− Just "https" -> runTLSSocket $ tlsSettings (userCfg <> "/certificate.pem") (userCfg <> "/key.pem")
123− _ -> runSettingsSocket
126+ prepareRunner = case (uri ^? uriScheme . _Just . unRText) of
127+ Just "https" -> do
128+ userCfg <- getXdgDirectory XdgConfig "obelisk"
129+ let (sslCertFile, sslKeyFile) = (userCfg <> "/certificate.pem", userCfg <> "/key.pem")
130+ sslCertExists <- doesFileExist sslCertFile
131+ sslKeyExists <- doesFileExist sslKeyFile
132+
133+ -- Generate private key and self-signed certificate if not already available
134+ unless (sslCertExists && sslKeyExists) $ do
135+ privateKey <- RSA.generateRSAKey' 2048 3
136+
137+ certRequest <- X509Request.newX509Req
138+ _ <- X509Request.setPublicKey certRequest privateKey
139+ _ <- X509Request.signX509Req certRequest privateKey Nothing
140+
141+ cert <- X509.newX509 >>= X509Request.makeX509FromReq certRequest
142+ _ <- X509.setPublicKey cert privateKey
143+ now <- getCurrentTime
144+ _ <- X509.setNotBefore cert $ addUTCTime (-1) now
145+ let days = 365
146+ _ <- X509.setNotAfter cert $ addUTCTime (days * 24 * 60 * 60) now
147+ _ <- X509.signX509 cert privateKey Nothing
148+
149+ _ <- createDirectoryIfMissing True userCfg
150+ PEM.writeX509 cert >>= writeFile sslCertFile
151+ PEM.writePKCS8PrivateKey privateKey Nothing >>= writeFile sslKeyFile
152+
153+ return $ runTLSSocket (tlsSettings sslCertFile sslKeyFile)
154+ _ -> return runSettingsSocket
155+ runner <- prepareRunner
124156 bracket
125157 (bindPortTCPRetry settings (logPortBindErr port) (_runConfig_retryTimeout conf))
126158 close