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 c206dbcf6..8df39cfe0 100644 --- a/src/Dbapi.hs +++ b/src/Dbapi.hs @@ -47,9 +47,8 @@ import Data.Ranged.Ranges (emptyRange) 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 289d6c81c..1407ac0c5 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -2,14 +2,15 @@ module Main where import Dbapi -import Middleware (inTransaction, authenticated, withSavepoint, clientErrors) +import Middleware (inTransaction, authenticated, withSavepoint, clientErrors, + 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) @@ -19,12 +20,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 @@ -32,13 +31,14 @@ 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 . clientErrors $ ( - inTransaction . authenticated (cs $ configAnonRole conf) . withSavepoint) app conn - + run port $ (if configSecure conf then redirectInsecure else id) + . gzip def . cors corsPolicy . clientErrors + $ (inTransaction . authenticated (cs $ configAnonRole conf) . withSavepoint) + app conn where describe = progDesc "create a REST API to an existing Postgres database" diff --git a/src/Middleware.hs b/src/Middleware.hs index 3997ecc15..9db7b1209 100644 --- a/src/Middleware.hs +++ b/src/Middleware.hs @@ -5,6 +5,7 @@ module Middleware where import Data.Aeson ((.=), toJSON, ToJSON, object, encode) import Data.Maybe (fromMaybe) +import Data.Monoid (mconcat) import Database.HDBC (runRaw) import Database.HDBC.PostgreSQL (Connection) @@ -12,29 +13,31 @@ import Database.HDBC.Types (SqlError(..)) import Data.String.Conversions(cs) import qualified Data.ByteString.Char8 as BS -import Control.Exception (finally, throw, catchJust, catch, SomeException, +import Control.Exception (finally, throw, catchJust, catch, SomeException, bracket_) -import Network.HTTP.Types.Header (RequestHeaders, hContentType, hAuthorization) -import Network.HTTP.Types.Status (status400, status401) -import Network.Wai (Application, requestHeaders, responseLBS) +import Network.HTTP.Types.Header (RequestHeaders, hContentType, hAuthorization, + hLocation) +import Network.HTTP.Types.Status (status400, status401, status301) +import Network.Wai (Application, requestHeaders, responseLBS, rawPathInfo, + rawQueryString, isSecure) +import Network.URI (URI(..), parseURI) import PgQuery(LoginAttempt(..), signInRole, setRole, resetRole) import Codec.Binary.Base64.String (decode) - inTransaction :: (Connection -> Application) -> (Connection -> Application) inTransaction app conn req respond = finally (runRaw conn "begin" >> app conn req respond) (runRaw conn "commit") -withSavepoint :: (Connection -> Application) -> Connection -> Application +withSavepoint :: (Connection -> Application) -> (Connection -> Application) withSavepoint app conn req respond = do runRaw conn "savepoint req_sp" catch (app conn req respond) (\e -> let _ = (e::SomeException) in runRaw conn "rollback to savepoint req_sp" >> throw e) -authenticated :: BS.ByteString -> (Connection -> Application) - -> Connection -> Application +authenticated :: BS.ByteString -> (Connection -> Application) -> + (Connection -> Application) authenticated anon app conn req respond = do attempt <- httpRequesterRole (requestHeaders req) case attempt of @@ -58,7 +61,6 @@ authenticated anon app conn req respond = do _ -> return MalformedAuth _ -> return NoCredentials - instance ToJSON SqlError where toJSON t = object [ "error" .= object [ @@ -78,3 +80,25 @@ clientErrors app req respond = where isPgException :: SqlError -> Maybe SqlError isPgException = Just + + +redirectInsecure :: Application -> Application +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 9cd0f08ae..c8e886a20 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 @@ -88,8 +88,8 @@ authHeader user pass = -- for hspec-wai pending_ :: WaiSession () -pending_ = liftIO pending +pending_ = liftIO Test.Hspec.pending -- for hspec-wai pendingWith_ :: String -> WaiSession () -pendingWith_ = liftIO . pendingWith +pendingWith_ = liftIO . Test.Hspec.pendingWith 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-----