Remove internal TLS, add option for HTTPS redirection

dbapi.cabal

@@ -1,5 +1,5 @@
 name:                  dbapi
-version:               0.1.0.0
+version:               0.2.0.0
 synopsis:              The database is your api
 license:               MIT
 license-file:          LICENSE
@@ -20,7 +20,7 @@ executable dbapi
                      , HTTP, convertible
                      , case-insensitive
                      , http-types, scientific, time
-                     , bytestring, aeson, network
+                     , bytestring, aeson, network >= 2.6
                      , text , containers
                      , optparse-applicative >= 0.9.1 && < 0.10
                      , unordered-containers
@@ -29,10 +29,10 @@ executable dbapi
                      , http-media, regex-tdfa
                      , Ranged-sets
                      , transformers
-                     , warp-tls
                      , bcrypt
                      , base64-string
                      , split
+                     , network-uri >= 2.6
   Other-Modules:       Dbapi
                      , PgStructure
                      , PgQuery
@@ -55,7 +55,7 @@ Test-Suite spec
                      , case-insensitive
                      , wai-extra, wai-cors, containers
                      , http-types, scientific, time
-                     , bytestring, aeson, network
+                     , bytestring, aeson, network >= 2.6
                      , text, optparse-applicative
                      , unordered-containers
                      , regex-base
@@ -63,7 +63,7 @@ Test-Suite spec
                      , http-media, regex-tdfa
                      , Ranged-sets
                      , transformers
-                     , warp-tls
                      , bcrypt
                      , base64-string
                      , split
+                     , network-uri >= 2.6

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

test/SpecHelper.hs

@@ -29,7 +29,7 @@ isLeft (Left _ ) = True
 isLeft _ = False
 
 cfg :: AppConfig
-cfg = AppConfig "postgres://dbapi_test:@localhost:5432/dbapi_test" 9000 "test/test.crt" "test/test.key" "dbapi_anonymous"
+cfg = AppConfig "postgres://dbapi_test:@localhost:5432/dbapi_test" 9000 "dbapi_anonymous" False
 
 openConnection :: IO Connection
 openConnection = connectPostgreSQL' $ configDbUri cfg

test/test.crt

@@ -1,14 +0,0 @@
------BEGIN CERTIFICATE-----
-MIICLTCCAZYCCQCj6GtISfdwNjANBgkqhkiG9w0BAQUFADBbMQswCQYDVQQGEwJV
-UzELMAkGA1UECBMCQ0ExFjAUBgNVBAcTDVNhbiBGcmFuY2lzY28xEzARBgNVBAoT
-Ckxvb3AgUmVjdXIxEjAQBgNVBAMTCWxvY2FsaG9zdDAeFw0xNDEwMDMyMDQyNDNa
-Fw0xNTEwMDMyMDQyNDNaMFsxCzAJBgNVBAYTAlVTMQswCQYDVQQIEwJDQTEWMBQG
-A1UEBxMNU2FuIEZyYW5jaXNjbzETMBEGA1UEChMKTG9vcCBSZWN1cjESMBAGA1UE
-AxMJbG9jYWxob3N0MIGfMA0GCSqGSIb3DQEBAQUAA4GNADCBiQKBgQC5gFnTRBge
-mXdkCMD+OycujZrCWOOLIDBqRr7kDbxVXqz/TKHRVx6bz88g9egzvR2HLyA418kd
-dAu+lMmjrRv/k0Lnk/UvC1aj0huoHpOVUgOwy3qS4cE663uU5qsrgf4RDP7bLDcQ
-FDW02SQ2n5ryv8nB9TSYpvQvYPiTMMKdrwIDAQABMA0GCSqGSIb3DQEBBQUAA4GB
-AAQwkC+GSaGArAKdMIqs8/55KAjyNd11MupiCWsu1cwBJ4QJc1PxrYOMLMYnU06J
-I0v1bJ6mG06/Js0r2FHM0NXSQO+7DLPWu4LchoBgFt4ZRm2+GbLzFrfu41yn5mJN
-VeUxCBQ9hOrE8Kwe+/9IUUVPxlISF+YHOyF3DxWUViak
------END CERTIFICATE-----

test/test.key

@@ -1,15 +0,0 @@
------BEGIN RSA PRIVATE KEY-----
-MIICXQIBAAKBgQC5gFnTRBgemXdkCMD+OycujZrCWOOLIDBqRr7kDbxVXqz/TKHR
-Vx6bz88g9egzvR2HLyA418kddAu+lMmjrRv/k0Lnk/UvC1aj0huoHpOVUgOwy3qS
-4cE663uU5qsrgf4RDP7bLDcQFDW02SQ2n5ryv8nB9TSYpvQvYPiTMMKdrwIDAQAB
-AoGAZZD0Haub9S0b5KayXMCwnFmmEaEvvR47xATGQgGPS8LRv9sKgp9LwA4RH7/k
-imeSglD4OIdVs421XH0ExlxjBiV5EzTCgLUyKbfA//xUy9ggXD1Ks4vIHL0c1DM4
-g6/zylN7CQtt4Bb6YdWDSAUXIl3U5Dj1kG7BWuXfJTxCx7ECQQDyLxoQRNkPwKP/
-xeOqfCgwyD52rnUJ7g9UViFcCU2ZLLEYxE4b3FECcwhOfUlxYvKdOx03Qts0taow
-dPU/BEXHAkEAxBVyKwTJ0T6rQmcQEx3WuaBhSjXgZigUN4OdXMg+LSO+1MON6Nhm
-J9ociy+xvfd0Cf3yABaAEU/hZ+Pmk2DI2QJBAO/XU8F+3VQrXH7l9HSXJppBBRM1
-7HScDRRhhAIIuI+UYgJ8DjqrMpLxZu2MSBqBenHZ5DIhBMOrkVMR0PrKeWsCQCHh
-gsSkIysgpP7oSALFmSCh8a2c+ZUtP7EH8NzjTLsH/iVNVOvy2FPygBQcvZ2RcF95
-naMeQCq9nrkQy/qTMqECQQDa1WjWS2ngwqGzHovqiKRg3lQ8MFNlvlStAQl8+9h0
-KJj8Rl6h+gO8eretBIe+y5j/hCC90xlJotzwO3jJF6Hc
------END RSA PRIVATE KEY-----