diff --git a/postgrest.cabal b/postgrest.cabal index 3fad79ee1..ebc7556f3 100644 --- a/postgrest.cabal +++ b/postgrest.cabal @@ -19,8 +19,8 @@ executable postgrest default-language: Haskell2010 default-extensions: OverloadedStrings, ScopedTypeVariables, QuasiQuotes build-depends: base >=4.6 && <5 - , hasql == 0.7.3, hasql-backend == 0.4.1 - , hasql-postgres == 0.10.3 + , hasql == 0.7.3.1, hasql-backend == 0.4.1 + , hasql-postgres == 0.10.3.1 , warp >= 3.0.2, wai >= 3.0.1 , wai-extra, wai-cors , wai-middleware-static >= 0.6.0 @@ -43,6 +43,7 @@ executable postgrest , vector , mtl , cassava + , jwt Other-Modules: App , Auth , Config @@ -74,8 +75,8 @@ Test-Suite spec , SpecHelper Build-Depends: base, hspec >= 2.1.2, QuickCheck , hspec-wai >= 0.5.0, hspec-wai-json - , hasql == 0.7.3, hasql-backend == 0.4.1 - , hasql-postgres == 0.10.3 + , hasql == 0.7.3.1, hasql-backend == 0.4.1 + , hasql-postgres == 0.10.3.1 , warp, wai , packdeps, hlint , HTTP, convertible @@ -102,3 +103,4 @@ Test-Suite spec , cassava , process , heredoc + , jwt diff --git a/src/App.hs b/src/App.hs index f49ac356b..b3acdf86d 100644 --- a/src/App.hs +++ b/src/App.hs @@ -34,13 +34,16 @@ import qualified Hasql as H import qualified Hasql.Backend as B import qualified Hasql.Postgres as P +import Config (AppConfig(..)) import Auth import PgQuery import RangeQuery import PgStructure -app :: Text -> BL.ByteString -> Request -> H.Tx P.Postgres s Response -app v1schema reqBody req = +import Prelude + +app :: AppConfig -> BL.ByteString -> Request -> H.Tx P.Postgres s Response +app conf reqBody req = case (path, verb) of ([], _) -> do body <- encode <$> tables (cs schema) @@ -102,6 +105,27 @@ app v1schema reqBody req = , (hLocation, "/postgrest/users?id=eq." <> cs (userId u)) ] "" + (["postgrest", "tokens"], "POST") -> + case jwtSecret of + "secret" -> return $ responseLBS status500 [jsonH] $ + encode . object $ [("message", String "JWT Secret is set as \"secret\" which is an unsafe default.")] + _ -> do + let user = decode reqBody :: Maybe AuthUser + + case user of + Nothing -> return $ responseLBS status400 [jsonH] $ + encode . object $ [("message", String "Failed to parse user.")] + Just u -> do + setRole authenticator + login <- signInRole (cs $ userId u) + (cs $ userPass u) + case login of + LoginSuccess role -> + return $ responseLBS status201 [ jsonH ] $ + encode . object $ [("token", String $ tokenJWT jwtSecret (cs $ userId u) role)] + _ -> return $ responseLBS status401 [jsonH] $ + encode . object $ [("message", String "Failed authentication.")] + ([table], "POST") -> do let qt = QualifiedTable schema (cs table) echoRequested = lookup "Prefer" hdrs == Just "return=representation" @@ -201,7 +225,9 @@ app v1schema reqBody req = verb = requestMethod req qq = queryString req hdrs = requestHeaders req - schema = requestedSchema v1schema hdrs + schema = requestedSchema (cs $ configV1Schema conf) hdrs + authenticator = cs $ configDbUser conf + jwtSecret = cs $ configJwtSecret conf range = rangeRequested hdrs allOrigins = ("Access-Control-Allow-Origin", "*") :: Header diff --git a/src/Auth.hs b/src/Auth.hs index e8f0f5be2..e8603a422 100644 --- a/src/Auth.hs +++ b/src/Auth.hs @@ -3,17 +3,21 @@ module Auth where import Data.Aeson import Control.Monad (mzero) -import Control.Applicative ( (<*>), (<$>) ) +import Control.Applicative import Crypto.BCrypt import Data.Text import Data.Monoid +import Data.Map import qualified Data.Vector as V import qualified Hasql as H import qualified Hasql.Backend as B import qualified Hasql.Postgres as P +import qualified Web.JWT as JWT import Data.String.Conversions (cs) import PgQuery (pgFmtLit) +import Prelude + import System.IO.Unsafe data AuthUser = AuthUser { @@ -26,7 +30,7 @@ instance FromJSON AuthUser where parseJSON (Object v) = AuthUser <$> v .: "id" <*> v .: "pass" <*> - v .: "role" + v .:? "role" .!= "" parseJSON _ = mzero instance ToJSON AuthUser where @@ -69,3 +73,19 @@ signInRole user pass = do then LoginSuccess role else LoginFailed ) u + +signInWithJWT :: Text -> Text -> LoginAttempt +signInWithJWT secret input = case maybeRole of + Just (Just (String role)) -> LoginSuccess $ cs role + _ -> LoginFailed + where + maybeRole = (Data.Map.lookup "role" <$> claims) ::Maybe (Maybe Value) + claims = JWT.unregisteredClaims <$> JWT.claims <$> decoded + decoded = JWT.decodeAndVerifySignature (JWT.secret secret) input + +tokenJWT :: Text -> Text -> Text -> Text +tokenJWT secret uid role = JWT.encodeSigned JWT.HS256 (JWT.secret secret) claimsSet + where + claimsSet = JWT.def { + JWT.unregisteredClaims = Data.Map.fromList [("id", String uid), ("role", String role)] + } \ No newline at end of file diff --git a/src/Config.hs b/src/Config.hs index f883fe1f1..321a033df 100644 --- a/src/Config.hs +++ b/src/Config.hs @@ -8,6 +8,7 @@ import qualified Data.ByteString.Char8 as BS import Data.String.Conversions (cs) import Options.Applicative hiding (columns) import Network.Wai.Middleware.Cors (CorsResourcePolicy(..)) +import Prelude data AppConfig = AppConfig { configDbName :: String @@ -21,6 +22,8 @@ data AppConfig = AppConfig { , configSecure :: Bool , configPool :: Int , configV1Schema :: String + + , configJwtSecret :: String } argParser :: Parser AppConfig @@ -36,6 +39,7 @@ argParser = AppConfig <*> switch (long "secure" <> short 's' <> help "Redirect all requests to HTTPS") <*> option auto (long "db-pool" <> metavar "COUNT" <> value 10 <> help "Max connections in database pool" <> showDefault) <*> strOption (long "v1schema" <> metavar "NAME" <> value "1" <> help "Schema to use for nonspecified version (or explicit v1)" <> showDefault) + <*> strOption (long "jwt-secret" <> metavar "SECRET" <> value "secret" <> help "Secret used to encrypt and decrypt JWT tokens)" <> showDefault) defaultCorsPolicy :: CorsResourcePolicy defaultCorsPolicy = CorsResourcePolicy Nothing diff --git a/src/Main.hs b/src/Main.hs index b8e19af61..b94e566ab 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -38,6 +38,8 @@ main = do unless (configSecure conf) $ putStrLn "WARNING, running in insecure mode, auth will be in plaintext" + unless ("secret" /= configJwtSecret conf) $ + putStrLn "WARNING, running in insecure mode, JWT secret is the default value" Prelude.putStrLn $ "Listening on port " ++ (show $ configPort conf :: String) @@ -53,8 +55,6 @@ main = do . (if configSecure conf then redirectInsecure else id) . gzip def . cors corsPolicy . staticPolicy (only [("favicon.ico", "static/favicon.ico")]) - anonRole = cs $ configAnonRole conf - currRole = cs $ configDbUser conf poolSettings <- maybe (fail "Improper session settings") return $ H.poolSettings (fromIntegral $ configPool conf) 30 @@ -64,7 +64,7 @@ main = do runSettings appSettings $ middle $ \req respond -> do body <- strictRequestBody req resOrError <- liftIO $ H.session pool $ H.tx Nothing $ - authenticated currRole anonRole (app (cs $ configV1Schema conf) body) req + authenticated conf (app conf body) req either (respond . errResponse) respond resOrError where diff --git a/src/Middleware.hs b/src/Middleware.hs index 429a6f6e5..95e132a5e 100644 --- a/src/Middleware.hs +++ b/src/Middleware.hs @@ -4,7 +4,7 @@ module Middleware where import Data.Maybe (fromMaybe) -import Data.Monoid (mconcat) +import Data.Monoid import Data.Text -- import Data.Pool(withResource, Pool) @@ -19,13 +19,16 @@ import Network.Wai (Application, requestHeaders, responseLBS, rawPathInfo, rawQueryString, isSecure, Request(..), Response) import Network.URI (URI(..), parseURI) -import Auth (LoginAttempt(..), signInRole, setRole, resetRole) +import Config (AppConfig(..)) +import Auth (LoginAttempt(..), signInRole, signInWithJWT, setRole, resetRole) import Codec.Binary.Base64.String (decode) -authenticated :: forall s. Text -> Text -> +import Prelude + +authenticated :: forall s. AppConfig -> (Request -> H.Tx P.Postgres s Response) -> Request -> H.Tx P.Postgres s Response -authenticated currentRole anon app req = do +authenticated conf app req = do attempt <- httpRequesterRole (requestHeaders req) case attempt of MalformedAuth -> @@ -36,6 +39,9 @@ authenticated currentRole anon app req = do NoCredentials -> if anon /= currentRole then runInRole anon else app req where + jwtSecret = cs $ configJwtSecret conf + currentRole = cs $ configDbUser conf + anon = cs $ configAnonRole conf httpRequesterRole :: RequestHeaders -> H.Tx P.Postgres s LoginAttempt httpRequesterRole hdrs = do let auth = fromMaybe "" $ lookup hAuthorization hdrs @@ -44,6 +50,8 @@ authenticated currentRole anon app req = do case split (==':') (cs . decode . cs $ b64) of (u:p:_) -> signInRole u p _ -> return MalformedAuth + ("Bearer" : jwt : _) -> + return $ signInWithJWT jwtSecret jwt _ -> return NoCredentials runInRole :: Text -> H.Tx P.Postgres s Response diff --git a/src/PgQuery.hs b/src/PgQuery.hs index 2fc3d5ad2..3c40271e9 100644 --- a/src/PgQuery.hs +++ b/src/PgQuery.hs @@ -17,7 +17,7 @@ import qualified Data.ByteString.Char8 as BS import Data.Monoid import Data.Vector (empty) import Data.Maybe (fromMaybe, mapMaybe) -import Data.Functor ( (<$>) ) +import Data.Functor import Control.Monad (join) import Data.String.Conversions (cs) import qualified Data.Aeson as JSON @@ -25,6 +25,8 @@ import qualified Data.List as L import qualified Data.Vector as V import Data.Scientific (isInteger, formatScientific, FPFormat(..)) +import Prelude + type PStmt = H.Stmt P.Postgres instance Monoid PStmt where mappend (B.Stmt query params prep) (B.Stmt query' params' prep') = diff --git a/src/PgStructure.hs b/src/PgStructure.hs index d9d226063..7d909e678 100644 --- a/src/PgStructure.hs +++ b/src/PgStructure.hs @@ -9,13 +9,15 @@ import Data.Aeson import Data.Functor.Identity import Data.String.Conversions (cs) import Data.Maybe (fromMaybe) -import Control.Applicative ( (<$>) ) +import Control.Applicative import qualified Data.Map as Map import qualified Hasql as H import qualified Hasql.Postgres as P +import Prelude + foreignKeys :: QualifiedTable -> H.Tx P.Postgres s (Map.Map Text ForeignKey) foreignKeys table = do r <- H.listEx $ [H.stmt| diff --git a/src/RangeQuery.hs b/src/RangeQuery.hs index 6eb4bfedf..3614e8379 100644 --- a/src/RangeQuery.hs +++ b/src/RangeQuery.hs @@ -20,6 +20,8 @@ import Text.Read (readMaybe) import Data.Maybe (fromMaybe, listToMaybe) +import Prelude + type NonnegRange = Range Int rangeParse :: BS.ByteString -> Maybe NonnegRange diff --git a/test/Feature/AuthSpec.hs b/test/Feature/AuthSpec.hs index 4af66137c..ae94f4f8f 100644 --- a/test/Feature/AuthSpec.hs +++ b/test/Feature/AuthSpec.hs @@ -18,13 +18,37 @@ spec = beforeAll it "hides tables that anonymous does not own" $ get "/authors_only" `shouldRespondWith` 404 - it "indicates login failure" $ do - let auth = authHeader "postgrest_test_author" "fakefake" + it "indicates login failure (BasicAuth)" $ do + let auth = authHeaderBasic "postgrest_test_author" "fakefake" request methodGet "/authors_only" [auth] "" `shouldRespondWith` 401 - it "allows users with permissions to see their tables" $ do + it "allows users with permissions to see their tables (BasicAuth)" $ do _ <- post "/postgrest/users" [json| { "id":"jdoe", "pass": "1234", "role": "postgrest_test_author" } |] - let auth = authHeader "jdoe" "1234" + let auth = authHeaderBasic "jdoe" "1234" request methodGet "/authors_only" [auth] "" `shouldRespondWith` 200 + + it "allows users to login (JWT)" $ do + _ <- post "/postgrest/users" [json| { "id":"jdoe", "pass": "1234", "role": "postgrest_test_author" } |] + post "/postgrest/tokens" [json| { "id":"jdoe", "pass": "1234" } |] + `shouldRespondWith` ResponseMatcher { + matchBody = Just [json| {"token":"eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJyb2xlIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIiwiaWQiOiJqZG9lIn0.y4vZuu1dDdwAl0-S00MCRWRYMlJ5YAMSir6Es6WtWx0"} |] + , matchStatus = 201 + , matchHeaders = ["Content-Type" <:> "application/json"] + } + + it "indicates login failure (JWT)" $ do + _ <- post "/postgrest/users" [json| { "id":"jdoe", "pass": "1234", "role": "postgrest_test_author" } |] + post "/postgrest/tokens" [json| { "id":"jdoe", "pass": "NOPE" } |] + `shouldRespondWith` ResponseMatcher { + matchBody = Just [json| {"message":"Failed authentication."} |] + , matchStatus = 401 + , matchHeaders = ["Content-Type" <:> "application/json"] + } + + it "allows users with permissions to see their tables (JWT)" $ do + _ <- post "/postgrest/users" [json| { "id":"jdoe", "pass": "1234", "role": "postgrest_test_author" } |] + let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJyb2xlIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIiwiaWQiOiJqZG9lIn0.y4vZuu1dDdwAl0-S00MCRWRYMlJ5YAMSir6Es6WtWx0" + request methodGet "/authors_only" [auth] "" + `shouldRespondWith` 200 \ No newline at end of file diff --git a/test/Feature/StructureSpec.hs b/test/Feature/StructureSpec.hs index caea5071a..d2994450a 100644 --- a/test/Feature/StructureSpec.hs +++ b/test/Feature/StructureSpec.hs @@ -27,7 +27,7 @@ spec = around withApp $ do it "lists only views user has permission to see" $ do _ <- post "/postgrest/users" [json| { "id":"jdoe", "pass": "1234", "role": "postgrest_test_author" } |] - let auth = authHeader "jdoe" "1234" + let auth = authHeaderBasic "jdoe" "1234" request methodGet "/" [auth] "" `shouldRespondWith` [json| [ diff --git a/test/SpecHelper.hs b/test/SpecHelper.hs index 73633ed7f..3afd0aafe 100644 --- a/test/SpecHelper.hs +++ b/test/SpecHelper.hs @@ -36,7 +36,7 @@ isLeft (Left _ ) = True isLeft _ = False cfg :: AppConfig -cfg = AppConfig "postgrest_test" 5432 "postgrest_test" "" "localhost" 3000 "postgrest_anonymous" False 10 "1" +cfg = AppConfig "postgrest_test" 5432 "postgrest_test" "" "localhost" 3000 "postgrest_anonymous" False 10 "1" "safe" testPoolOpts :: PoolSettings testPoolOpts = fromMaybe (error "bad settings") $ H.poolSettings 1 30 @@ -50,15 +50,13 @@ pgSettings = P.ParamSettings (cs $ configDbHost cfg) withApp :: ActionWith Application -> IO () withApp perform = do - let anonRole = cs $ configAnonRole cfg - currRole = cs $ configDbUser cfg pool :: H.Pool P.Postgres <- H.acquirePool pgSettings testPoolOpts perform $ middle $ \req resp -> do body <- strictRequestBody req result <- liftIO $ H.session pool $ H.tx Nothing - $ authenticated currRole anonRole (app (cs $ configV1Schema cfg) body) req + $ authenticated cfg (app cfg body) req either (resp . errResponse) resp result where middle = cors corsPolicy @@ -93,9 +91,13 @@ matchHeader :: CI BS.ByteString -> String -> [Header] -> Bool matchHeader name valRegex headers = maybe False (=~ valRegex) $ lookup name headers -authHeader :: String -> String -> Header -authHeader u p = +authHeaderBasic :: String -> String -> Header +authHeaderBasic u p = (hAuthorization, cs $ "Basic " ++ encode (u ++ ":" ++ p)) + +authHeaderJWT :: String -> Header +authHeaderJWT token = + (hAuthorization, cs $ "Bearer " ++ token) testPool :: IO(H.Pool P.Postgres) testPool = H.acquirePool pgSettings testPoolOpts diff --git a/test/TestTypes.hs b/test/TestTypes.hs index e5e02bc87..8e655f492 100644 --- a/test/TestTypes.hs +++ b/test/TestTypes.hs @@ -8,9 +8,11 @@ module TestTypes ( import qualified Data.Aeson as JSON import Data.Aeson ((.:)) -- import Data.Maybe (fromJust) -import Control.Applicative ((<$>), (<*>)) +import Control.Applicative import Control.Monad (mzero) +import Prelude + data IncPK = IncPK { incId :: Int , incNullableStr :: Maybe String