Remove internal TLS, add option for HTTPS redirection

src/Dbapi.hs

@@ -49,9 +49,8 @@ import Codec.Binary.Base64.String (decode)
 data AppConfig = AppConfig {
     configDbUri :: String
   , configPort  :: Int
-  , configSslCert :: FilePath
-  , configSslKey  :: FilePath
   , configAnonRole :: String
+  , configSecure :: Bool
   }
 
 jsonContentType :: (HeaderName, BS.ByteString)

src/Main.hs

@@ -4,14 +4,14 @@
 
 module Main where
 import Dbapi
-import Middleware (reportPgErrors)
+import Middleware (reportPgErrors, redirectInsecure)
 import Network.Wai.Handler.Warp hiding (Connection)
 import Database.HDBC.PostgreSQL (connectPostgreSQL')
 import Data.String.Conversions (cs)
 
+import Control.Monad (unless)
 import Control.Applicative
 import Options.Applicative hiding (columns)
-import Network.Wai.Handler.WarpTLS (tlsSettings, runTLS)
 import Network.Wai.Middleware.Gzip (gzip, def)
 import Network.Wai.Middleware.Cors (cors)
 
@@ -23,12 +23,10 @@ argParser = AppConfig
     <> help "database uri to expose, e.g. postgres://user:pass@host:port/database")
   <*> option (long "port" <> short 'p' <> metavar "NUMBER" <> value 3000
     <> help "port number on which to run HTTP server")
-  <*> strOption (long "sslcert" <> short 'c' <> metavar "PATH" <> value "test/test.crt"
-    <> help "path to SSL cert file")
-  <*> strOption (long "sslkey" <> short 'k' <> metavar "PATH" <> value "test/test.key"
-    <> help "path to SSL key file")
   <*> strOption (long "anonymous" <> short 'a' <> metavar "ROLE"
     <> help "postgres role to use for non-authenticated requests")
+  <*> switch (long "secure" <> short 's'
+    <> help "Redirect all requests to HTTPS" )
 
 main :: IO ()
 main = do
@@ -36,12 +34,16 @@ main = do
   let port = configPort conf
   let dburi = configDbUri conf
 
-  let tls = tlsSettings (configSslCert conf) (configSslKey conf)
-  let settings = setPort port defaultSettings
+  unless (configSecure conf) $
+    putStrLn "WARNING, running in insecure mode, auth will be in plaintext"
 
   Prelude.putStrLn $ "Listening on port " ++ (show $ configPort conf :: String)
   conn <- connectPostgreSQL' dburi
-  runTLS tls settings $ gzip def $ cors corsPolicy $ reportPgErrors $ app conn (cs $ configAnonRole conf)
+  run port $ (if configSecure conf then redirectInsecure else id)
+           $ gzip def
+           $ cors corsPolicy
+           $ reportPgErrors
+           $ app conn (cs $ configAnonRole conf)
 
   where
     describe = progDesc "create a REST API to an existing Postgres database"

src/Middleware.hs

@@ -5,12 +5,14 @@ module Middleware where
 
 import Data.Aeson
 
-import Network.HTTP.Types.Header (hContentType)
-import Network.HTTP.Types.Status (status400)
+import Network.HTTP.Types.Header (hContentType, hLocation)
+import Network.HTTP.Types.Status (status400, status301)
 import Database.HDBC.Types (SqlError(..))
 import Control.Exception (catchJust)
+import Data.String.Conversions (cs)
 import Network.Wai
-
+import Network.URI (URI(..), parseURI)
+import Data.Monoid (mconcat)
 
 instance ToJSON SqlError where
   toJSON t = object [
@@ -31,3 +33,25 @@ reportPgErrors app req respond =
   where
     isPgException :: SqlError -> Maybe SqlError
     isPgException = Just
+
+
+redirectInsecure :: Middleware
+redirectInsecure app req respond = do
+  let hdrs = requestHeaders req
+      host = lookup "host" hdrs
+      uriM = parseURI . cs =<< mconcat [
+        Just "https://",
+        host,
+        Just $ rawPathInfo req,
+        Just $ rawQueryString req]
+      isHerokuSecure = lookup "x-forwarded-proto" hdrs == Just "https"
+
+  if not (isSecure req || isHerokuSecure)
+    then case uriM of
+              Just uri ->
+                respond $ responseLBS status301 [
+                    (hLocation, cs . show $ uri { uriScheme = "https:" })
+                  ] ""
+              Nothing ->
+                respond $ responseLBS status400 [] "SSL is required"
+    else app req respond