From abccb295a385e22c9bb6acb90228f4288f8d5489 Mon Sep 17 00:00:00 2001 From: Joe Nelson Date: Sun, 12 Oct 2014 19:41:35 -0700 Subject: [PATCH] Remove internal TLS, add option for HTTPS redirection --- dbapi.cabal | 10 +++++----- src/Dbapi.hs | 3 +-- src/Main.hs | 20 +++++++++++--------- src/Middleware.hs | 30 +++++++++++++++++++++++++++--- test/SpecHelper.hs | 2 +- test/test.crt | 14 -------------- test/test.key | 15 --------------- 7 files changed, 45 insertions(+), 49 deletions(-) delete mode 100644 test/test.crt delete mode 100644 test/test.key diff --git a/dbapi.cabal b/dbapi.cabal index 05fadc8ce..44bb15f24 100644 --- a/dbapi.cabal +++ b/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 diff --git a/src/Dbapi.hs b/src/Dbapi.hs index 9ce15f69a..362444b2d 100644 --- a/src/Dbapi.hs +++ b/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) diff --git a/src/Main.hs b/src/Main.hs index 38f3598a4..b53b143b1 100644 --- a/src/Main.hs +++ b/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" diff --git a/src/Middleware.hs b/src/Middleware.hs index ce289346f..c5c035fe7 100644 --- a/src/Middleware.hs +++ b/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 diff --git a/test/SpecHelper.hs b/test/SpecHelper.hs index 2180a282f..f8d6b9613 100644 --- a/test/SpecHelper.hs +++ b/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 diff --git a/test/test.crt b/test/test.crt deleted file mode 100644 index 8de4a6729..000000000 --- a/test/test.crt +++ /dev/null @@ -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----- diff --git a/test/test.key b/test/test.key deleted file mode 100644 index 4e8faeca7..000000000 --- a/test/test.key +++ /dev/null @@ -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-----