From 02e85ea26fc297d41a91c91d12b3e2aa290e62ff Mon Sep 17 00:00:00 2001
From: Igor Pashev <pashev.igor@gmail.com>
Date: Mon, 28 Nov 2016 21:24:51 +0300
Subject: Allow running in plain HTTP mode (no SSL)

This can be useful when Sproxy is behind some
other proxy or load-balancer.
---
 src/Sproxy/Config.hs | 12 ++++++++----
 src/Sproxy/Server.hs | 49 ++++++++++++++++++++++++++++++++++---------------
 2 files changed, 42 insertions(+), 19 deletions(-)

(limited to 'src')

diff --git a/src/Sproxy/Config.hs b/src/Sproxy/Config.hs
index e76b436..4cae025 100644
--- a/src/Sproxy/Config.hs
+++ b/src/Sproxy/Config.hs
@@ -17,14 +17,16 @@ import Sproxy.Logging (LogLevel(Debug))
 
 data ConfigFile = ConfigFile {
   cfListen       :: Word16
+, cfSsl          :: Bool
 , cfUser         :: String
 , cfHome         :: FilePath
 , cfLogLevel     :: LogLevel
-, cfSslCert      :: FilePath
-, cfSslKey       :: FilePath
+, cfSslCert      :: Maybe FilePath
+, cfSslKey       :: Maybe FilePath
 , cfSslCertChain :: [FilePath]
 , cfKey          :: Maybe FilePath
 , cfListen80     :: Maybe Bool
+, cfHttpsPort    :: Maybe Word16
 , cfBackends     :: [BackendConf]
 , cfOAuth2       :: HashMap Text OAuth2Conf
 , cfDataFile     :: Maybe FilePath
@@ -36,14 +38,16 @@ data ConfigFile = ConfigFile {
 instance FromJSON ConfigFile where
   parseJSON (Object m) = ConfigFile <$>
         m .:? "listen"         .!= 443
+    <*> m .:? "ssl"            .!= True
     <*> m .:? "user"           .!= "sproxy"
     <*> m .:? "home"           .!= "."
     <*> m .:? "log_level"      .!= Debug
-    <*> m .:  "ssl_cert"
-    <*> m .:  "ssl_key"
+    <*> m .:? "ssl_cert"
+    <*> m .:? "ssl_key"
     <*> m .:? "ssl_cert_chain" .!= []
     <*> m .:? "key"
     <*> m .:? "listen80"
+    <*> m .:? "https_port"
     <*> m .:  "backends"
     <*> m .:  "oauth2"
     <*> m .:? "datafile"
diff --git a/src/Sproxy/Server.hs b/src/Sproxy/Server.hs
index 3c34b0c..6e24bfd 100644
--- a/src/Sproxy/Server.hs
+++ b/src/Sproxy/Server.hs
@@ -14,11 +14,12 @@ import Data.Word (Word16)
 import Data.Yaml (decodeFileEither)
 import Network.HTTP.Client (Manager, ManagerSettings(..), defaultManagerSettings, newManager, socketConnection)
 import Network.HTTP.Client.Internal (Connection)
-import Network.Socket ( Family(AF_INET, AF_UNIX), SockAddr(SockAddrInet, SockAddrUnix),
+import Network.Socket ( Socket, Family(AF_INET, AF_UNIX), SockAddr(SockAddrInet, SockAddrUnix),
   SocketOption(ReuseAddr), SocketType(Stream), bind, close, connect, inet_addr,
   listen, maxListenQueue, setSocketOption, socket )
+import Network.Wai (Application)
 import Network.Wai.Handler.WarpTLS (tlsSettingsChain, runTLSSocket)
-import Network.Wai.Handler.Warp ( defaultSettings, runSettingsSocket,
+import Network.Wai.Handler.Warp ( Settings, defaultSettings, runSettingsSocket,
   setHTTP2Disabled, setOnException )
 import System.Entropy (getEntropy)
 import System.Environment (setEnv)
@@ -37,6 +38,11 @@ import qualified Sproxy.Logging as Log
 import qualified Sproxy.Server.DB as DB
 
 
+{- TODO:
+ - Log.error && exitFailure should be replaced
+ - by Log.fatal && wait for logger thread to print && exitFailure
+-}
+
 server :: FilePath -> IO ()
 server configFile = do
   cf <- readConfigFile configFile
@@ -81,13 +87,6 @@ server configFile = do
       setOnException (\_ _ -> return ())
       defaultSettings
 
-  case maybe80 of
-    Nothing     -> return ()
-    Just sock80 -> do
-      Log.info "listening on port 80 (HTTP redirect)"
-      listen sock80 maxListenQueue
-      void . forkIO $ runSettingsSocket settings sock80 (redirect $ cfListen cf)
-
   oauth2clients <- HM.fromList <$> mapM newOAuth2Client (HM.toList (cfOAuth2 cf))
 
   backends <-
@@ -96,15 +95,22 @@ server configFile = do
       return (compile $ beName be, be, m)
     ) $ cfBackends cf
 
+
+  warpServer <- newServer cf
+
+  case maybe80 of
+    Nothing     -> return ()
+    Just sock80 -> do
+      let httpsPort = fromMaybe (cfListen cf) (cfHttpsPort cf)
+      Log.info "listening on port 80 (HTTP redirect)"
+      listen sock80 maxListenQueue
+      void . forkIO $ runSettingsSocket settings sock80 (redirect httpsPort)
+
   -- XXX 2048 is from bindPortTCP from streaming-commons used internally by runTLS.
   -- XXX Since we don't call runTLS, we listen socket here with the same options.
-  Log.info $ "listening on port " ++ show (cfListen cf) ++ " (HTTPS)"
+  Log.info $ "proxy listening on port " ++ show (cfListen cf)
   listen sock (max 2048 maxListenQueue)
-  runTLSSocket
-    (tlsSettingsChain (cfSslCert cf) (cfSslCertChain cf) (cfSslKey cf))
-    settings
-    sock
-    (sproxy key db oauth2clients backends)
+  warpServer settings sock (sproxy key db oauth2clients backends)
 
 
 newDataSource :: ConfigFile -> IO (Maybe DB.DataSource)
@@ -167,6 +173,19 @@ newBackendManager be = do
   }
 
 
+newServer :: ConfigFile -> IO (Settings -> Socket -> Application -> IO ())
+newServer cf
+  | cfSsl cf =
+    case (cfSslKey cf, cfSslCert cf) of
+      (Just k, Just c) ->
+        return $ runTLSSocket (tlsSettingsChain c (cfSslCertChain cf) k)
+      _ -> do Log.error "missings SSL certificate"
+              exitFailure
+  | otherwise = do
+      Log.warn "not using SSL!"
+      return runSettingsSocket
+
+
 openUnixSocketConnection :: FilePath -> IO Connection
 openUnixSocketConnection f =
   bracketOnError
-- 
cgit v1.2.3