jimmy/postgrest
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Merge pull request #194 from framp/jwt

Browse Source 
JWT support
This commit is contained in:
Joe Nelson
2015-05-19 22:17:34 -07:00
parent e35ad0f340 77aecc9e86
commit dcf62b020f
13 changed files with 124 additions and 30 deletions
Download Patch File Download Diff File Expand all files Collapse all files
postgrest.cabal
+6 -4
View File
@@ -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
src/App.hs
+29 -3
View File
@@ -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
src/Auth.hs
+22 -2
View File
@@ -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)]
}
src/Config.hs
+4
View File
@@ -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
src/Main.hs
+3 -3
View File
@@ -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
src/Middleware.hs
+12 -4
View File
@@ -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
src/PgQuery.hs
+3 -1
View File
@@ -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') =
src/PgStructure.hs
+3 -1
View File
@@ -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|
src/RangeQuery.hs
+2
View File
@@ -20,6 +20,8 @@ import Text.Read (readMaybe)
import Data.Maybe (fromMaybe, listToMaybe)
import Prelude
type NonnegRange = Range Int
rangeParse :: BS.ByteString -> Maybe NonnegRange
test/Feature/AuthSpec.hs
+28 -4
View File
@@ -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
test/Feature/StructureSpec.hs
+1 -1
View File
@@ -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| [
test/SpecHelper.hs
+8 -6
View File
@@ -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
test/TestTypes.hs
+3 -1
View File
@@ -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