@@ -18,6 +18,7 @@ import Control.Category
18import Control.Concurrent
18import Control.Concurrent
19import Control.Exception
19import Control.Exception
20import Control.Lens ((%~), (^?), _Just, _Right)
20import Control.Lens ((%~), (^?), _Just, _Right)
21+import Control.Monad (unless)
21import qualified Data.Attoparsec.ByteString.Char8 as A
22import qualified Data.Attoparsec.ByteString.Char8 as A
22import Data.ByteString (ByteString)
23import Data.ByteString (ByteString)
23import qualified Data.ByteString.Char8 as BSC
24import qualified Data.ByteString.Char8 as BSC
@@ -35,6 +36,7 @@ import Data.String (fromString)
35import Data.Text (Text)
36import Data.Text (Text)
36import qualified Data.Text as T
37import qualified Data.Text as T
37import qualified Data.Text.Encoding as T
38import qualified Data.Text.Encoding as T
39+import Data.Time.Clock (getCurrentTime, addUTCTime)
38import Language.Javascript.JSaddle.Run (syncPoint)
40import Language.Javascript.JSaddle.Run (syncPoint)
39import Language.Javascript.JSaddle.WebSockets
41import Language.Javascript.JSaddle.WebSockets
40import Network.HTTP.Client (Manager, defaultManagerSettings, newManager)
42import Network.HTTP.Client (Manager, defaultManagerSettings, newManager)
@@ -52,9 +54,13 @@ import qualified Obelisk.Asset.Serve.Snap as Snap
52import Obelisk.Backend
54import Obelisk.Backend
53import Obelisk.Frontend
55import Obelisk.Frontend
54import Obelisk.Route.Frontend
56import 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
55import Reflex.Dom.Core
61import Reflex.Dom.Core
56import Snap.Core (Snap)
62import Snap.Core (Snap)
57−import System.Directory (getXdgDirectory, XdgDirectory(..))
63+import System.Directory (getXdgDirectory, XdgDirectory(..), doesFileExist, createDirectoryIfMissing)
58import System.Environment
64import System.Environment
59import System.IO
65import System.IO
60import System.Process
66import System.Process
@@ -110,7 +116,6 @@ runWidget
111runWidget conf configs frontend validFullEncoder = do
117runWidget conf configs frontend validFullEncoder = do
112 uri <- either (fail . T.unpack) pure $ getConfigRoute configs
118 uri <- either (fail . T.unpack) pure $ getConfigRoute configs
113− userCfg <- getXdgDirectory XdgConfig "obelisk"
114 let port = fromIntegral $ fromMaybe 80 $ uri ^? uriAuthority . _Right . authPort . _Just
119 let port = fromIntegral $ fromMaybe 80 $ uri ^? uriAuthority . _Right . authPort . _Just
115 redirectHost = _runConfig_redirectHost conf
120 redirectHost = _runConfig_redirectHost conf
116 redirectPort = _runConfig_redirectPort conf
121 redirectPort = _runConfig_redirectPort conf
@@ -118,9 +123,36 @@ runWidget conf configs frontend validFullEncoder = do
118 putStrLn $ "Frontend running on " <> T.unpack (URI.render uri)
123 putStrLn $ "Frontend running on " <> T.unpack (URI.render uri)
119 settings = setBeforeMainLoop beforeMainLoop (setPort port (setTimeout 3600 defaultSettings))
124 settings = setBeforeMainLoop beforeMainLoop (setPort port (setTimeout 3600 defaultSettings))
120 -- Providing TLS here will also incidentally provide it to proxied requests to the backend.
125 -- Providing TLS here will also incidentally provide it to proxied requests to the backend.
121− runner = case (uri ^? uriScheme . _Just . unRText) of
126+ prepareRunner = case (uri ^? uriScheme . _Just . unRText) of
122− Just "https" -> runTLSSocket $ tlsSettings (userCfg <> "/certificate.pem") (userCfg <> "/key.pem")
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
133+ -- Generate private key and self-signed certificate if not already available
134+ unless (sslCertExists && sslKeyExists) $ do
135+ privateKey <- RSA.generateRSAKey' 2048 3
137+ certRequest <- X509Request.newX509Req
138+ _ <- X509Request.setPublicKey certRequest privateKey
139+ _ <- X509Request.signX509Req certRequest privateKey Nothing
141+ cert <- X509.newX509 >>= X509Request.makeX509FromReq certRequest
142+ _ <- X509.setPublicKey cert privateKey
143+ now <- getCurrentTime
144+ _ <- X509.setNotBefore cert $ addUTCTime (-1) now
146+ _ <- X509.setNotAfter cert $ addUTCTime (days * 24 * 60 * 60) now
147+ _ <- X509.signX509 cert privateKey Nothing
149+ _ <- createDirectoryIfMissing True userCfg
150+ PEM.writeX509 cert >>= writeFile sslCertFile
151+ PEM.writePKCS8PrivateKey privateKey Nothing >>= writeFile sslKeyFile
153+ return $ runTLSSocket (tlsSettings sslCertFile sslKeyFile)
123− _ -> runSettingsSocket
154+ _ -> return runSettingsSocket
155+ runner <- prepareRunner
125 (bindPortTCPRetry settings (logPortBindErr port) (_runConfig_retryTimeout conf))
157 (bindPortTCPRetry settings (logPortBindErr port) (_runConfig_retryTimeout conf))