Merge pull request #320 from diogob/jwt_generic_variables

Jwt generic variables

postgrest.cabal

@@ -66,34 +66,48 @@ library
 
   default-language:    Haskell2010
   default-extensions:  OverloadedStrings, ScopedTypeVariables, QuasiQuotes
-  build-depends:       base >=4.6 && <5
+  build-depends:       HTTP
-                     , hasql, hasql-backend
+                     , MissingH
-                     , hasql-postgres
-                     , warp, wai
-                     , wai-extra, wai-cors
-                     , wai-middleware-static
-                     , HTTP, convertible, http-types
-                     , case-insensitive
-                     , scientific, time
-                     , aeson, network
-                     , bytestring, text, split, string-conversions
-                     , stringsearch
-                     , containers, unordered-containers
-                     , optparse-applicative
-                     , regex-base, regex-tdfa
                      , Ranged-sets
-                     , transformers, MissingH
+                     , aeson
-                     , bcrypt, base64-string
+                     , base >=4.6 && <5
-                     , network-uri
+                     , base64-string
-                     , resource-pool
+                     , bcrypt
-                     , blaze-builder
-                     , vector
-                     , mtl
-                     , cassava
-                     , jwt
-                     , parsec
-                     , errors
                      , bifunctors
+                     , blaze-builder
+                     , bytestring
+                     , case-insensitive
+                     , cassava
+                     , containers
+                     , convertible
+                     , errors
+                     , hasql
+                     , hasql-backend
+                     , hasql-postgres
+                     , http-types
+                     , jwt
+                     , mtl
+                     , network
+                     , network-uri
+                     , optparse-applicative
+                     , parsec
+                     , regex-base
+                     , regex-tdfa
+                     , resource-pool
+                     , scientific
+                     , split
+                     , string-conversions
+                     , stringsearch
+                     , text
+                     , time
+                     , transformers
+                     , unordered-containers
+                     , vector
+                     , wai
+                     , wai-cors
+                     , wai-extra
+                     , wai-middleware-static
+                     , warp
 
   Other-Modules:       Paths_postgrest
   Exposed-Modules:     PostgREST.App

src/PostgREST/App.hs

@@ -40,13 +40,13 @@ import           Network.Wai.Internal      (Response (..))
 import           Network.Wai.Parse         (parseHttpAccept)
 
 import           Data.Aeson
+import           Data.Aeson.Types (emptyArray)
 import           Data.Monoid
 import qualified Data.Vector               as V
 import qualified Hasql                     as H
 import qualified Hasql.Backend             as B
 import qualified Hasql.Postgres            as P
 
-import           PostgREST.Auth
 import           PostgREST.Config          (AppConfig (..))
 import           PostgREST.Parsers
 import           PostgREST.PgQuery
@@ -54,14 +54,16 @@ import           PostgREST.PgStructure
 import           PostgREST.QueryBuilder
 import           PostgREST.RangeQuery
 import           PostgREST.Types
+import           PostgREST.Auth (tokenJWT)
 
 import           Prelude
 
-app :: DbStructure -> AppConfig -> DbRole -> BL.ByteString -> DbRole -> Request -> H.Tx P.Postgres s Response
+app :: DbStructure -> AppConfig -> BL.ByteString -> Request -> H.Tx P.Postgres s Response
-app dbstructure conf authenticator reqBody dbrole req =
+app dbstructure conf reqBody req =
   case (path, verb) of
 
     ([], _) -> do
+      Identity (dbrole :: Text) <- H.singleEx $ [H.stmt|SELECT current_user|]
       let body = encode $ filter (filterTableAcl dbrole) $ filter ((cs schema==).tableSchema) allTabs
       return $ responseLBS status200 [jsonH] $ cs body
 
@@ -130,41 +132,6 @@ app dbstructure conf authenticator reqBody dbrole req =
             countQuery = requestToCountQuery schema <$> apiRequest
             queries = (,) <$> query <*> countQuery
 
-
-    (["postgrest", "users"], "POST") -> 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
-          _ <- addUser (cs $ userId u)
-            (cs $ userPass u) (cs <$> userRole u)
-          return $ responseLBS status201
-            [ jsonH
-            , (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 uid ->
-                  return $ responseLBS status201 [ jsonH ] $
-                    encode . object $ [("token", String $ tokenJWT jwtSecret uid role)]
-                _  -> return $ responseLBS status401 [jsonH] $
-                  encode . object $ [("message", String "Failed authentication.")]
-
     ([table], "POST") -> do
       let qt = qualify table
           echoRequested = hasPrefer "return=representation"
@@ -207,9 +174,13 @@ app dbstructure conf authenticator reqBody dbrole req =
         then do
           let call = B.Stmt "select " V.empty True <>
                 asJson (callProc qi $ fromMaybe M.empty (decode reqBody))
-          body :: Maybe (Identity Text) <- H.maybeEx call
+          bodyJson :: Maybe (Identity Value) <- H.maybeEx call
+          returnJWT <- doesProcReturnJWT schema proc
           return $ responseLBS status200 [jsonH]
-            (cs $ fromMaybe "[]" $ runIdentity <$> body)
+                 (let body = fromMaybe emptyArray $ runIdentity <$> bodyJson in
+                    if returnJWT
+                    then "{\"token\":\"" <> cs (tokenJWT jwtSecret body) <> "\"}"
+                    else cs $ encode body)
         else return $ responseLBS status404 [] ""
 
       -- check that proc exists
@@ -295,7 +266,7 @@ app dbstructure conf authenticator reqBody dbrole req =
     hasPrefer val = any (\(h,v) -> h == "Prefer" && v == val) hdrs
     accept        = lookupHeader hAccept
     schema        = cs $ configSchema conf
-    jwtSecret     = cs $ configJwtSecret conf
+    jwtSecret     = (cs $ configJwtSecret conf) :: Text
     range         = rangeRequested hdrs
     allOrigins    = ("Access-Control-Allow-Origin", "*") :: Header
     contentType   = fromMaybe "application/json" $ contentTypeForAccept accept

src/PostgREST/Auth.hs

@@ -1,104 +1,76 @@
-module PostgREST.Auth where
+{-# LANGUAGE FlexibleContexts #-}
+{-|
+Module      : PostgREST.Auth
+Description : PostgREST authorization functions.
 
-import           Control.Applicative
+This module provides functions to deal with the JWT authorization (http://jwt.io).
-import           Control.Monad           (mzero)
+It also can be used to define other authorization functions,
-import           Crypto.BCrypt
+in the future Oauth, LDAP and similar integrations can be coded here.
-import           Data.Aeson
+
-import           Data.Map
+Authentication should always be implemented in an external service.
-import           Data.Monoid
+In the test suite there is an example of simple login function that can be used for a
+very simple authentication system inside the PostgreSQL database.
+-}
+module PostgREST.Auth (
+  setRole
+  , claimsToSQL
+  , jwtClaims
+  , tokenJWT
+  ) where
+
+--line needed for ghc 7.8
+import           Data.Functor            ((<$>))
+ 
+import           Data.Aeson              (Value (..), Object)
+import           Data.Aeson.Types        (emptyObject, emptyArray)
+import           Data.Vector             as V (null, head)
+import           Data.Map                as M (fromList, toList)
+import           Data.Monoid             ((<>))
 import           Data.String.Conversions (cs)
-import           Data.Text
+import           Data.Text               (Text)
-import           Data.Maybe (isNothing)
+import           PostgREST.PgQuery       (pgFmtLit, pgFmtIdent, unquoted)
-import qualified Data.Vector             as V
-import qualified Hasql                   as H
-import qualified Hasql.Backend           as B
-import qualified Hasql.Postgres          as P
-import           PostgREST.PgQuery       (pgFmtLit)
-import           Prelude
 import qualified Web.JWT                 as JWT
+import qualified Data.HashMap.Lazy       as H
 
-import           System.IO.Unsafe
+{-|
-
+  Receives a map of JWT claims and returns a list
-data AuthUser = AuthUser {
+  of PostgreSQL statements to set the claims as user defined GUCs.
-    userId   :: String
+  Except if we have a claim called role,
-  , userPass :: String
+  this one is mapped to a SET ROLE statement.
-  , userRole :: Maybe String
+  In case there is any problem decoding the JWT it returns Nothing.
-  } deriving (Show)
+-}
-
+claimsToSQL :: JWT.ClaimsMap -> [Text]
-instance FromJSON AuthUser where
+claimsToSQL = map setVar . toList
-  parseJSON (Object v) = AuthUser <$>
+  where
-                         v .: "id" <*>
+    setVar ("role", String val) = setRole val
-                         v .: "pass" <*>
+    setVar (k, val) = "set local postgrest.claims." <> pgFmtIdent k <>
-                         v .:? "role"
+                      " = " <> valueToVariable val <> ";"
-  parseJSON _ = mzero
+    valueToVariable = pgFmtLit . unquoted
-
+
-instance ToJSON AuthUser where
+{-|
-  toJSON u = object [
+  Receives the JWT secret (from config) and a JWT and
-      "id" .= userId u
+  returns a map of JWT claims
-    , "pass" .= userPass u
+  In case there is any problem decoding the JWT it returns Nothing.
-    , "role" .= userRole u ]
+-}
-
+jwtClaims :: Text -> Text -> Maybe JWT.ClaimsMap
-type DbRole = Text
+jwtClaims secret input = JWT.unregisteredClaims <$> JWT.claims <$> decoded
-type UserId = Text
-
-data LoginAttempt =
-    NoCredentials
-  | MalformedAuth
-  | LoginFailed
-  | LoginSuccess DbRole UserId
-  deriving (Eq, Show)
-
-checkPass :: Text -> Text -> Bool
-checkPass = (. cs) . validatePassword . cs
-
-setRole :: Text -> H.Tx P.Postgres s ()
-setRole role = H.unitEx $ B.Stmt ("set local role " <> cs (pgFmtLit role)) V.empty True
-
-setUserId :: Text -> H.Tx P.Postgres s ()
-setUserId uid =
-  if uid /= ""
-    then H.unitEx $ B.Stmt ("set local user_vars.user_id = " <> cs (pgFmtLit uid)) V.empty True
-    else resetUserId
-
-resetUserId :: H.Tx P.Postgres s ()
-resetUserId = H.unitEx [H.stmt|reset user_vars.user_id|]
-
-addUser :: Text -> Text -> Maybe Text -> H.Tx P.Postgres s ()
-addUser identity pass role =
-  H.unitEx $
-    if isNothing role
-      then [H.stmt|insert into postgrest.auth (id, pass) values (?, ?)|]
-        identity hashedText
-      else [H.stmt|insert into postgrest.auth (id, pass, rolname) values (?, ?, ?)|]
-        identity hashedText role
-  where Just hashed = unsafePerformIO $ hashPasswordUsingPolicy fastBcryptHashingPolicy (cs pass)
-        hashedText = cs hashed :: Text
-
-signInRole :: Text -> Text -> H.Tx P.Postgres s LoginAttempt
-signInRole user pass = do
-  u <- H.maybeEx $ [H.stmt|select id, pass, rolname from postgrest.auth where id = ?|] user
-  return $ maybe LoginFailed (\r ->
-      let (uid, hashed, role) = r in
-      if checkPass hashed pass
-         then LoginSuccess role uid
-         else LoginFailed
-    ) u
-
-signInWithJWT :: Text -> Text -> LoginAttempt
-signInWithJWT secret input = case maybeRole of
-    Just (Just (String role)) -> case maybeUserId of
-      Just (Just (String uid)) -> LoginSuccess (cs role) (cs uid)
-      _   -> LoginFailed
-    _   -> LoginFailed
   where
-    maybeRole = (Data.Map.lookup "role" <$> claims) ::Maybe (Maybe Value)
-    maybeUserId = (Data.Map.lookup "id" <$> claims) ::Maybe (Maybe Value)
-    claims = JWT.unregisteredClaims <$> JWT.claims <$> decoded
     decoded = JWT.decodeAndVerifySignature (JWT.secret secret) input
 
-tokenJWT :: Text -> Text -> Text -> Text
+-- | Receives the name of a role and returns a SET ROLE statement
-tokenJWT secret uid role = JWT.encodeSigned JWT.HS256 (JWT.secret secret) claimsSet
+setRole :: Text -> Text
-  where
+setRole role = "set local role " <> cs (pgFmtLit role) <> ";"
-    claimsSet = JWT.def {
+
-      JWT.unregisteredClaims = Data.Map.fromList [("id", String uid), ("role", String role)]
+
-    }
+{-|
+  Receives the JWT secret (from config) and a JWT and a JSON value
+  and returns a signed JWT.
+-}
+tokenJWT :: Text -> Value -> Text
+tokenJWT secret (Array a) = JWT.encodeSigned JWT.HS256 (JWT.secret secret)
+                               JWT.def { JWT.unregisteredClaims = fromHashMap o }
+                          where
+                            Object o = if V.null a then emptyObject else V.head a
+                            fromHashMap :: Object -> JWT.ClaimsMap
+                            fromHashMap = M.fromList . H.toList
+tokenJWT secret _          = tokenJWT secret emptyArray

src/PostgREST/Main.hs

@@ -98,5 +98,5 @@ main = do
   runSettings appSettings $ middle $ \ req respond -> do
     body <- strictRequestBody req
     resOrError <- liftIO $ H.session pool $ H.tx txSettings $
-      authenticated conf authenticator (app dbstructure conf authenticator body) req
+      runWithClaims conf (app dbstructure conf body) req
     either (respond . errResponse) respond resOrError

src/PostgREST/Middleware.hs

@@ -3,6 +3,9 @@
 
 module PostgREST.Middleware where
 
+-- needed for ghc 7.8
+import           Data.Functor ((<$>))
+
 import           Data.Maybe                    (fromMaybe, isNothing)
 import           Data.Monoid
 import           Data.Text
@@ -10,11 +13,9 @@ import           Data.String.Conversions       (cs)
 import qualified Hasql                         as H
 import qualified Hasql.Postgres                as P
 
-import           Network.HTTP.Types            (RequestHeaders)
 import           Network.HTTP.Types.Header     (hAccept, hAuthorization,
                                                 hLocation)
-import           Network.HTTP.Types.Status     (status301, status400, status401,
+import           Network.HTTP.Types.Status     (status301, status400, status415)
-                                                status415)
 import           Network.URI                   (URI (..), parseURI)
 import           Network.Wai                   (Application, Request (..),
                                                 Response, isSecure, rawPathInfo,
@@ -24,49 +25,37 @@ import           Network.Wai.Middleware.Cors   (cors)
 import           Network.Wai.Middleware.Gzip   (def, gzip)
 import           Network.Wai.Middleware.Static (only, staticPolicy)
 
-import           Codec.Binary.Base64.String    (decode)
 import           PostgREST.App                 (contentTypeForAccept)
-import           PostgREST.Auth                (DbRole, LoginAttempt (..),
+import           PostgREST.Auth                (setRole, jwtClaims, claimsToSQL)
-                                                setRole, setUserId, signInRole,
-                                                signInWithJWT)
 import           PostgREST.Config              (AppConfig (..), corsPolicy)
 
-import           Prelude
+import           Prelude hiding(concat)
 
-authenticated :: forall s. AppConfig -> DbRole ->
+import qualified Data.Vector             as V
-                 (DbRole -> Request -> H.Tx P.Postgres s Response) ->
+import qualified Hasql.Backend           as B
+import qualified Data.Map.Lazy           as M
+
+runWithClaims :: forall s. AppConfig ->
+                 (Request -> H.Tx P.Postgres s Response) ->
                  Request -> H.Tx P.Postgres s Response
-authenticated conf authenticator app req = do
+runWithClaims conf app req = do
-  attempt <- httpRequesterRole (requestHeaders req)
+    mapM_ H.unitEx $ stmt <$> env
-  case attempt of
+    app req
-    MalformedAuth ->
-      return $ responseLBS status400 [] "Malformed basic auth header"
-    LoginFailed ->
-      return $ responseLBS status401 [] "Invalid username or password"
-    LoginSuccess role uid -> if role /= authenticator then runInRole role uid else app authenticator req
-    NoCredentials         -> if anon /= authenticator then runInRole anon "" else app authenticator req
-
  where
-   jwtSecret = cs $ configJwtSecret conf
+   stmt = (flip $ flip B.Stmt V.empty) True
+   hdrs = requestHeaders req
+   jwtSecret = (cs $ configJwtSecret conf) :: Text
+   auth = fromMaybe "" $ lookup hAuthorization hdrs
    anon = cs $ configAnonRole conf
-   httpRequesterRole :: RequestHeaders -> H.Tx P.Postgres s LoginAttempt
+   claims =
-   httpRequesterRole hdrs = do
+     fromMaybe (M.fromList []) $
-    let auth = fromMaybe "" $ lookup hAuthorization hdrs
+     case split (==' ') (cs auth) of
-    case split (==' ') (cs auth) of
+       ("Bearer" : jwt : _) -> jwtClaims jwtSecret jwt
-      ("Basic" : b64 : _) ->
+       _ -> Nothing
-        case split (==':') (cs . decode . cs $ b64) of
+   env = if M.member "role" claims
-          (u:p:_) -> signInRole u p
+            then jwtEnv
-          _ -> return MalformedAuth
+            else setRole anon : jwtEnv
-      ("Bearer" : jwt : _) ->
+   jwtEnv = claimsToSQL claims
-        return $ signInWithJWT jwtSecret jwt
-      _ -> return NoCredentials
-
-   runInRole :: Text -> Text -> H.Tx P.Postgres s Response
-   runInRole r uid = do
-     setUserId uid
-     setRole r
-     app r req
-
 
 redirectInsecure :: Application -> Application
 redirectInsecure app req respond = do

src/PostgREST/PgStructure.hs

@@ -13,25 +13,39 @@ import           Data.Monoid
 import           Data.Text             (Text, split)
 import qualified Hasql                 as H
 import qualified Hasql.Postgres        as P
+import qualified Hasql.Backend         as B
 import           PostgREST.PgQuery     ()
 import           PostgREST.Types
 
 import           GHC.Exts              (groupWith)
 import           Prelude
 
+doesProc :: forall c s. B.CxValue c Int =>
+            (Text -> Text -> B.Stmt c) -> Text -> Text -> H.Tx c s Bool
+doesProc stmt schema proc = do
+  row :: Maybe (Identity Int) <- H.maybeEx $ stmt schema proc
+  return $ isJust row
 
 doesProcExist :: Text -> Text -> H.Tx P.Postgres s Bool
-doesProcExist schema proc = do
+doesProcExist = doesProc [H.stmt|
-  row :: Maybe (Identity Int) <- H.maybeEx $ [H.stmt|
       SELECT 1
       FROM   pg_catalog.pg_namespace n
       JOIN   pg_catalog.pg_proc p
       ON     pronamespace = n.oid
       WHERE  nspname = ?
       AND    proname = ?
-    |] schema proc
+    |]
-  return $ isJust row
 
+doesProcReturnJWT :: Text -> Text -> H.Tx P.Postgres s Bool
+doesProcReturnJWT = doesProc [H.stmt|
+      SELECT 1
+      FROM   pg_catalog.pg_namespace n
+      JOIN   pg_catalog.pg_proc p
+      ON     pronamespace = n.oid
+      WHERE  nspname = ?
+      AND    proname = ?
+      AND    pg_catalog.pg_get_function_result(p.oid) = 'jwt_claims'
+    |]
 
 tableFromRow :: (Text, Text, Bool, Maybe Text) -> Table
 tableFromRow (s, n, i, a) = Table s n i (parseAcl a)
@@ -153,7 +167,7 @@ allRelations = do
 allColumns :: [Relation] -> H.Tx P.Postgres s [Column]
 allColumns rels = do
   cols <- H.listEx $ [H.stmt|
-      SELECT
+      SELECT DISTINCT
           info.table_schema AS schema,
           info.table_name AS table_name,
           info.column_name AS name,

test/Feature/AuthSpec.hs

@@ -18,55 +18,32 @@ spec = beforeAll
   it "hides tables that anonymous does not own" $
     get "/authors_only" `shouldRespondWith` 404
 
-  it "indicates login failure (BasicAuth)" $ do
+  it "returns jwt functions as jwt tokens" $
-    let auth = authHeaderBasic "postgrest_test_author" "fakefake"
+    post "/rpc/login" [json| { "id": "jdoe", "pass": "1234" } |]
-    request methodGet "/authors_only" [auth] ""
-      `shouldRespondWith` 401
-
-  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 = authHeaderBasic "jdoe" "1234"
-    request methodGet "/authors_only" [auth] ""
-      `shouldRespondWith` 200
-
-  it "respects database constraints for role" $
-    post "/postgrest/users" [json| { "id": "ssmith", "pass": "1234", "role": "SUPER_ADMIN_TRUNCATE_POWERS" } |]
-      `shouldRespondWith` 400
-
-  it "does not send a value when no role is provided" $ do
-    post "/postgrest/users" [json| { "id": "bdeey", "pass": "1234" } |]
-      `shouldRespondWith` 201
-    let auth = authHeaderBasic "jdoe" "1234"
-    request methodGet "/authors_only" [auth] ""
-      `shouldRespondWith` 200
-
-  it "recovers after 400 error with logged in user" $ do
-    _ <- post "/postgrest/users" [json| { "id": "jdoe", "pass": "1234", "role": "postgrest_test_author" } |]
-    let auth = authHeaderBasic "jdoe" "1234"
-    _ <- request methodPost "/rpc/problem" [auth] ""
-    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
+        , matchStatus = 200
         , matchHeaders = ["Content-Type" <:> "application/json"]
         }
 
-  it "indicates login failure (JWT)" $ do
+  it "allows users with permissions to see their tables" $ 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
+
+  it "hides tables from users with invalid JWT" $ do
+    let auth = authHeaderJWT "ey9zdGdyZXN0X3Rlc3RfYXV0aG9yIiwiaWQiOiJqZG9lIn0.y4vZuu1dDdwAl0-S00MCRWRYMlJ5YAMSir6Es6WtWx0"
+    request methodGet "/authors_only" [auth] ""
+      `shouldRespondWith` 404
+
+  it "hides tables from users with JWT that contain no claims about role" $ do
+    let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.e30.MKYc_lOECtB0LJOiykilAdlHodB-I0_id2qHKq35dmc"
+    request methodGet "/authors_only" [auth] ""
+      `shouldRespondWith` 404
+
+  it "recovers after 400 error with logged in user" $ do
+    _ <- post "/authors_only" [json| { "owner": "jdoe", "secret": "test content" } |]
+    let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJyb2xlIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIiwiaWQiOiJqZG9lIn0.y4vZuu1dDdwAl0-S00MCRWRYMlJ5YAMSir6Es6WtWx0"
+    _ <- request methodPost "/rpc/problem" [auth] ""
+    request methodGet "/authors_only" [auth] ""
+      `shouldRespondWith` 200

test/Feature/InsertSpec.hs

@@ -284,11 +284,12 @@ spec = afterAll_ resetDb $ around withApp $ do
 
   describe "Row level permission" $
     it "set user_id when inserting rows" $ do
+      let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJyb2xlIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIiwiaWQiOiJqZG9lIn0.y4vZuu1dDdwAl0-S00MCRWRYMlJ5YAMSir6Es6WtWx0"
       _ <- post "/postgrest/users" [json| { "id":"jdoe", "pass": "1234", "role": "postgrest_test_author" } |]
       _ <- post "/postgrest/users" [json| { "id":"jroe", "pass": "1234", "role": "postgrest_test_author" } |]
 
       p1 <- request methodPost "/authors_only"
-        [ authHeaderBasic "jdoe" "1234", ("Prefer", "return=representation") ]
+        [ auth, ("Prefer", "return=representation") ]
         [json| { "secret": "nyancat" } |]
       liftIO $ do
           simpleBody p1 `shouldBe` [json| { "owner":"jdoe", "secret":"nyancat" } |]

test/Feature/StructureSpec.hs

@@ -40,8 +40,7 @@ spec = around withApp $ do
         {matchStatus = 200}
 
     it "lists only views user has permission to see" $ do
-      _ <- post "/postgrest/users" [json| { "id":"jdoe", "pass": "1234", "role": "postgrest_test_author" } |]
+      let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJyb2xlIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIiwiaWQiOiJqZG9lIn0.y4vZuu1dDdwAl0-S00MCRWRYMlJ5YAMSir6Es6WtWx0"
-      let auth = authHeaderBasic "jdoe" "1234"
 
       request methodGet "/" [auth] ""
         `shouldRespondWith` [json| [

test/SpecHelper.hs

@@ -20,7 +20,6 @@ import Network.HTTP.Types.Header (Header, ByteRange, renderByteRange,
 import Codec.Binary.Base64.String (encode)
 import Data.CaseInsensitive (CI(..))
 import Data.Maybe (fromMaybe)
-import Data.Functor.Identity
 import Text.Regex.TDFA ((=~))
 import qualified Data.ByteString.Char8 as BS
 import System.Process (readProcess)
@@ -55,10 +54,6 @@ withApp perform = do
   pool :: H.Pool P.Postgres
     <- H.acquirePool pgSettings testPoolOpts
 
-  Right authenticator <- H.session pool $ do
-    Identity (role :: Text) <- H.tx Nothing $ H.singleEx [H.stmt|SELECT SESSION_USER|]
-    return role
-
   let txSettings = Just (H.ReadCommitted, Just True)
   metadata <- H.session pool $ H.tx txSettings $ do
     tabs <- allTables
@@ -80,7 +75,7 @@ withApp perform = do
   perform $ middle $ \req resp -> do
     body <- strictRequestBody req
     result <- liftIO $ H.session pool $ H.tx txSettings
-      $ authenticated cfg authenticator (app dbstructure cfg authenticator body) req
+      $ runWithClaims cfg (app dbstructure cfg body) req
     either (resp . errResponse) resp result
 
   where middle = defaultMiddle False

test/fixtures/schema.sql

@@ -76,7 +76,7 @@ CREATE FUNCTION set_authors_only_owner() RETURNS trigger
     LANGUAGE plpgsql
     AS $$
 begin
-  NEW.owner = current_setting('user_vars.user_id');
+  NEW.owner = current_setting('postgrest.claims.id');
   RETURN NEW;
 end
 $$;
@@ -268,15 +268,6 @@ CREATE VIEW test.projects_view AS
       projects.client_id
   FROM projects;
 ALTER TABLE test.projects_view OWNER TO postgrest_test;
-------- SAMPLE DATA -----
-INSERT INTO clients VALUES (1, 'Microsoft'),(2, 'Apple');
-INSERT INTO projects VALUES (1,'Windows 7', 1),(2,'Windows 10', 1),(3,'IOS', 2),(4,'OSX', 2);
-INSERT INTO tasks VALUES (1,'Design w7',1),(2,'Code w7',1),(3,'Design w10',2),(4,'Code w10',2),(5,'Design IOS',3),(6,'Code IOS',3),(7,'Design OSX',4),(8,'Code OSX',4);
-INSERT INTO users VALUES (1, 'Angela Martin'),(2, 'Michael Scott'),(3, 'Dwight Schrute');
-INSERT INTO users_projects VALUES(1,1),(1,2),(2,3),(2,4),(3,1),(3,3);
-INSERT INTO users_tasks VALUES(1,1),(1,2),(1,3),(1,4),(2,5),(2,6),(2,7),(3,1),(3,5);
-INSERT INTO comments VALUES (1, 1, 2, 6, 'Needs to be delivered ASAP');
-----------------
 
 CREATE SEQUENCE items_id_seq
     START WITH 1
@@ -298,6 +289,13 @@ CREATE FUNCTION test.getitemrange(min bigint, max bigint) RETURNS SETOF test.ite
 $$ LANGUAGE SQL;
 
 
+CREATE TYPE public.jwt_claims AS (role text, id text);
+CREATE FUNCTION test.login(id text, pass text)
+RETURNS public.jwt_claims
+SECURITY DEFINER
+AS $$
+SELECT rolname::text, id::text FROM postgrest.auth WHERE id = id AND pass = pass;
+$$ LANGUAGE SQL;
 
 CREATE FUNCTION test.sayhello(name text) RETURNS text AS $$
     SELECT 'Hello, ' || $1;
@@ -663,6 +661,10 @@ REVOKE ALL ON FUNCTION getitemrange(bigint, bigint) FROM postgrest_test;
 GRANT EXECUTE ON FUNCTION getitemrange(bigint, bigint) TO postgrest_test;
 GRANT EXECUTE ON FUNCTION getitemrange(bigint, bigint) TO postgrest_anonymous;
 
+REVOKE ALL ON FUNCTION login(text, text) FROM PUBLIC;
+REVOKE ALL ON FUNCTION login(text, text) FROM postgrest_test;
+GRANT EXECUTE ON FUNCTION login(text, text) TO postgrest_test;
+GRANT EXECUTE ON FUNCTION login(text, text) TO postgrest_anonymous;
 
 REVOKE ALL ON FUNCTION sayhello(text) FROM PUBLIC;
 REVOKE ALL ON FUNCTION sayhello(text) FROM postgrest_test;
@@ -758,3 +760,16 @@ SET search_path = private, pg_catalog;
 REVOKE ALL ON TABLE articles FROM PUBLIC;
 REVOKE ALL ON TABLE articles FROM postgrest_test;
 GRANT ALL ON TABLE articles TO postgrest_test;
+
+SET search_path = test, private, postgrest, public, pg_catalog;
+
+------- SAMPLE DATA -----
+INSERT INTO clients VALUES (1, 'Microsoft'),(2, 'Apple');
+INSERT INTO projects VALUES (1,'Windows 7', 1),(2,'Windows 10', 1),(3,'IOS', 2),(4,'OSX', 2);
+INSERT INTO tasks VALUES (1,'Design w7',1),(2,'Code w7',1),(3,'Design w10',2),(4,'Code w10',2),(5,'Design IOS',3),(6,'Code IOS',3),(7,'Design OSX',4),(8,'Code OSX',4);
+INSERT INTO users VALUES (1, 'Angela Martin'),(2, 'Michael Scott'),(3, 'Dwight Schrute');
+INSERT INTO users_projects VALUES(1,1),(1,2),(2,3),(2,4),(3,1),(3,3);
+INSERT INTO users_tasks VALUES(1,1),(1,2),(1,3),(1,4),(2,5),(2,6),(2,7),(3,1),(3,5);
+INSERT INTO comments VALUES (1, 1, 2, 6, 'Needs to be delivered ASAP');
+INSERT INTO postgrest.auth (id, pass, rolname) VALUES ('jdoe', '1234', 'postgrest_test_author');
+----------------