Merge pull request #703 from begriffs/jwt

Big bag of JWT fixes for accumulated issues

CHANGELOG.md

@@ -7,12 +7,13 @@ This project adheres to [Semantic Versioning](http://semver.org/).
 
 ### Added
 - Ability to generate an OpenAPI spec - @mainx07, @hudayou, @ruslantalpa, @begriffs
-- Ability to generate an OpenAPI spec behind a proxy- @hudayou
+- Ability to generate an OpenAPI spec behind a proxy - @hudayou
 - Ability to set addresses to listen on - @hudayou
 - Filtering, shaping and embedding with &select for the /rpc path - @ruslantalpa
 - Output names of used-defined types (instead of 'USER-DEFINED') - @martingms
 - Implement support for singular representation responses for POST/PATCH requests - @ehamberg
 - Include RPC endpoints in OpenAPI output - @begriffs, @LogvinovLeon
+- Custom request validation with `--pre-request` argument - @begriffs
 
 ### Fixed
 - Do not apply limit to parent items - @ruslantalpa
@@ -23,6 +24,9 @@ This project adheres to [Semantic Versioning](http://semver.org/).
 - Remove non-OpenAPI schema description - @begriffs
 - Use comma rather than semicolon to separate Prefer header values - @begriffs
 - Omit total query count by default - @begriffs
+- No more reserved `jwt_claims` return type - @begriffs
+- HTTP 401 rather than 400 for expired JWT - @begriffs
+- Remove default JWT secret - @begriffs
 
 ## [0.3.2.0] - 2016-06-10
 

main/Main.hs

@@ -11,8 +11,11 @@ import           PostgREST.Config                     (AppConfig (..),
 import           PostgREST.OpenAPI                    (isMalformedProxyUri)
 import           PostgREST.DbStructure
 
+import           Control.AutoUpdate
 import           Data.String                          (IsString (..))
+import           Data.Text                            (stripPrefix)
 import           Data.Function                        (id)
+import           Data.Time.Clock.POSIX                (getPOSIXTime)
 import qualified Hasql.Query                          as H
 import qualified Hasql.Session                        as H
 import qualified Hasql.Decoders                       as HD
@@ -21,7 +24,6 @@ import qualified Hasql.Pool                           as P
 import           Network.Wai.Handler.Warp
 import           System.IO                            (BufferMode (..),
                                                        hSetBuffering)
-import           Web.JWT                              (secret)
 import           Data.IORef
 #ifndef mingw32_HOST_OS
 import           System.Posix.Signals
@@ -42,7 +44,7 @@ main = do
   hSetBuffering stdin  LineBuffering
   hSetBuffering stderr NoBuffering
 
-  conf <- readOptions
+  conf <- loadSecretFile =<< readOptions
   let host = configHost conf
       port = configPort conf
       proxy = configProxyUri conf
@@ -55,8 +57,6 @@ main = do
   when (isMalformedProxyUri $ toS <$> proxy) $ panic
     "Malformed proxy uri, a correct example: https://example.com:8443/basePath"
 
-  unless (secret "secret" /= configJwtSecret conf) $
-    putStrLn ("WARNING, running in insecure mode, JWT secret is the default value" :: Text)
   putStrLn $ ("Listening on port " :: Text) <> show (configPort conf)
 
   pool <- P.acquire (configPool conf, 10, pgSettings)
@@ -85,4 +85,16 @@ main = do
    ) Nothing
 #endif
 
-  runSettings appSettings $ postgrest conf refDbStructure pool
+  -- ask for the OS time at most once per second
+  getTime <- mkAutoUpdate
+    defaultUpdateSettings { updateAction = getPOSIXTime }
+
+  runSettings appSettings $ postgrest conf refDbStructure pool getTime
+
+loadSecretFile :: AppConfig -> IO AppConfig
+loadSecretFile conf = do
+  let s = configJwtSecret conf
+  real <- case join (stripPrefix "@" <$> s) of
+            Nothing -> return s -- the string is the secret, not a filename
+            Just filename -> sequence . Just $ readFile (toS filename)
+  return conf { configJwtSecret = real }

postgrest.cabal

@@ -30,6 +30,7 @@ executable postgrest
     "-with-rtsopts=-N -I2"
   default-language:    Haskell2010
   build-depends:       aeson (>= 0.8 && < 0.10) || (>= 0.11 && < 0.12)
+                     , auto-update
                      , base >= 4.8 && < 6
                      , bytestring
                      , bytestring-tree-builder == 0.2.7
@@ -143,6 +144,7 @@ Test-Suite spec
                      , Feature.CorsSpec
                      , Feature.DeleteSpec
                      , Feature.InsertSpec
+                     , Feature.NoJwtSpec
                      , Feature.QuerySpec
                      , Feature.QueryLimitedSpec
                      , Feature.RangeSpec
@@ -151,6 +153,7 @@ Test-Suite spec
                      , SpecHelper
                      , TestTypes
   Build-Depends:       aeson
+                     , auto-update
                      , aeson-qq
                      , async
                      , base

src/PostgREST/App.hs

@@ -7,12 +7,13 @@ module PostgREST.App (
 ) where
 
 import           Control.Applicative
-import qualified Data.ByteString.Char8   as BS
+import qualified Data.ByteString.Char8     as BS
 import           Data.IORef                (IORef, readIORef)
 import           Data.List                 (delete, lookup)
 import           Data.Maybe                (fromJust)
 import           Data.Ranged.Ranges        (emptyRange)
 import           Data.Text                 (replace, strip, isInfixOf, dropWhile, drop, intercalate)
+import           Data.Time.Clock.POSIX     (POSIXTime)
 import           Data.Tree
 
 import qualified Hasql.Pool                as P
@@ -25,13 +26,13 @@ import qualified Text.InterpolatedString.Perl6 as P6 (q)
 
 import           Network.HTTP.Types.Header
 import           Network.HTTP.Types.Status
-import           Network.HTTP.Types.URI (renderSimpleQuery)
+import           Network.HTTP.Types.URI    (renderSimpleQuery)
 import           Network.Wai
 import           Network.Wai.Middleware.RequestLogger (logStdout)
+import           Web.JWT                   (secret)
 
 import           Data.Aeson
-import           Data.Aeson.Types (emptyArray)
+import           Data.Aeson.Types          (emptyArray)
-import           Data.Time.Clock.POSIX     (getPOSIXTime)
 import qualified Data.Vector               as V
 import qualified Hasql.Transaction         as H
 
@@ -44,7 +45,7 @@ import           PostgREST.ApiRequest   (ApiRequest(..), ContentType(..)
                                             , ctToHeader
                                             , userApiRequest
                                             , toHeader)
-import           PostgREST.Auth            (tokenJWT, jwtClaims, containsRole)
+import           PostgREST.Auth            (jwtClaims, containsRole)
 import           PostgREST.Config          (AppConfig (..))
 import           PostgREST.DbStructure
 import           PostgREST.Error           (errResponse, pgErrResponse)
@@ -68,18 +69,20 @@ import           Data.Foldable (foldr1)
 import           Data.Function (id)
 import           Protolude                hiding (dropWhile, drop, intercalate, Proxy)
 
-postgrest :: AppConfig -> IORef DbStructure -> P.Pool -> Application
+postgrest :: AppConfig -> IORef DbStructure -> P.Pool -> IO POSIXTime ->
-postgrest conf refDbStructure pool =
+             Application
+postgrest conf refDbStructure pool getTime =
   let middle = (if configQuiet conf then id else logStdout) . defaultMiddle in
 
   middle $ \ req respond -> do
-    time <- getPOSIXTime
+    time <- getTime
     body <- strictRequestBody req
     dbStructure <- readIORef refDbStructure
 
     let schema = toS $ configSchema conf
         apiRequest = userApiRequest schema req body
-        eClaims = jwtClaims (configJwtSecret conf) (iJWT apiRequest) time
+        eClaims = jwtClaims
+          (secret <$> configJwtSecret conf) (iJWT apiRequest) time
         authed = containsRole eClaims
         handleReq = runWithClaims conf eClaims (app dbStructure conf) apiRequest
         txMode = transactionMode $ iAction apiRequest
@@ -211,21 +214,14 @@ app dbStructure conf apiRequest =
      Just (PayloadJSON (UniformObjects payload))) -> do
         let p = V.head payload
             singular = iPreferSingular apiRequest
-            jwtSecret = configJwtSecret conf
-            returnType = lookup (qiName qi) $ dbProcs dbStructure
-            returnsJWT = fromMaybe False $
-              isInfixOf "jwt_claims" . pdReturnType <$> returnType
         serves [CTApplicationJSON] (iAccepts apiRequest) $ \_ -> case readSqlParts of
           Left e -> return $ responseLBS status400 [jsonH] $ toS e
           Right (q,cq) -> respondToRange $ do
             row <- H.query () (callProc qi p q cq topLevelRange shouldCount singular)
-            let (tableTotal, queryTotal, body) = fromMaybe (Just 0, 0, emptyArray) row
+            let (tableTotal, queryTotal, body) =
+                  fromMaybe (Just 0, 0, emptyArray) row
                 (status, contentRange) = rangeHeader queryTotal tableTotal
-              in
+            return $ responseLBS status [jsonH, contentRange] (toS . encode $ body)
-              return $ responseLBS status [jsonH, contentRange]
-                      (if returnsJWT
-                      then "{\"token\":\"" <> toS (tokenJWT jwtSecret body) <> "\"}"
-                      else toS $ encode body)
 
     (ActionRead, TargetRoot, Nothing) -> do
       let host = configHost conf

src/PostgREST/Auth.hs

@@ -16,6 +16,7 @@ module PostgREST.Auth (
   , containsRole
   , jwtClaims
   , tokenJWT
+  , JWTAttempt(..)
   ) where
 
 import           Protolude
@@ -47,22 +48,33 @@ claimsToSQL claims = roleStmts <> varStmts
   valueToVariable = pgFmtLit . unquoted
 
 {-|
-  Receives the JWT secret (from config) and a JWT and
+  Possible situations encountered with client JWTs
-  returns a map of JWT claims
-  In case there is any problem decoding the JWT it returns an error Text
 -}
-jwtClaims :: JWT.Secret -> Text -> NominalDiffTime -> Either Text (M.HashMap Text Value)
+data JWTAttempt = JWTExpired
-jwtClaims _ "" _ = Right M.empty
+                | JWTInvalid
+                | JWTMissingSecret
+                | JWTClaims (M.HashMap Text Value)
+                deriving Eq
+
+{-|
+  Receives the JWT secret (from config) and a JWT and returns a map
+  of JWT claims.
+-}
+jwtClaims :: Maybe JWT.Secret -> Text -> NominalDiffTime -> JWTAttempt
+jwtClaims _ "" _ = JWTClaims M.empty
 jwtClaims secret jwt time =
-  case isExpired <$> mClaims of
+  case secret of
-    Just True -> Left "JWT expired"
+    Nothing -> JWTMissingSecret
-    Nothing -> Left "Invalid JWT"
+    Just s ->
-    Just False -> Right $ value2map $ fromJust mClaims
+      let mClaims = toJSON . JWT.claims <$> JWT.decodeAndVerifySignature s jwt in
+      case isExpired <$> mClaims of
+        Just True -> JWTExpired
+        Nothing -> JWTInvalid
+        Just False -> JWTClaims $ value2map $ fromJust mClaims
  where
   isExpired claims =
     let mExp = claims ^? key "exp" . _Integer
     in fromMaybe False $ (<= time) . fromInteger <$> mExp
-  mClaims = toJSON . JWT.claims <$> JWT.decodeAndVerifySignature secret jwt
   value2map (Object o) = o
   value2map _          = M.empty
 
@@ -80,6 +92,6 @@ tokenJWT secret _ = tokenJWT secret emptyArray
 {-|
   Whether a response from jwtClaims contains a role claim
 -}
-containsRole :: Either Text (M.HashMap Text Value) -> Bool
+containsRole :: JWTAttempt -> Bool
-containsRole (Left _) = False
+containsRole (JWTClaims claims) = M.member "role" claims
-containsRole (Right claims) = M.member "role" claims
+containsRole _ = False

src/PostgREST/Config.hs

@@ -31,7 +31,6 @@ import           Options.Applicative
 import           Paths_postgrest             (version)
 import           Protolude hiding            (intercalate)
 import           Safe                        (readMay)
-import           Web.JWT                     (Secret, secret)
 
 -- | Data type to store all command line options
 data AppConfig = AppConfig {
@@ -41,9 +40,10 @@ data AppConfig = AppConfig {
   , configSchema    :: Text
   , configHost      :: Text
   , configPort      :: Int
-  , configJwtSecret :: Secret
+  , configJwtSecret :: Maybe Text
   , configPool      :: Int
   , configMaxRows   :: Maybe Integer
+  , configReqCheck  :: Maybe Text
   , configQuiet     :: Bool
   }
 
@@ -55,10 +55,10 @@ argParser = AppConfig
   <*> (toS <$> strOption    (long "schema"     <> short 's' <> help "schema to use for API routes" <> metavar "NAME" <> value "public" <> showDefault))
   <*> (toS <$> strOption    (long "host"       <> short 'l' <> help "hostname or ip on which to run HTTP server" <> metavar "HOST" <> value "*4" <> showDefault))
   <*> option auto  (long "port"       <> short 'p' <> help "port number on which to run HTTP server" <> metavar "PORT" <> value 3000 <> showDefault)
-  <*> (secret . toS <$>
+  <*> (optional . map toS <$> strOption) (long "jwt-secret" <> short 'j' <> help "secret used to encrypt and decrypt JWT tokens" <> metavar "SECRET")
-      strOption    (long "jwt-secret" <> short 'j' <> help "secret used to encrypt and decrypt JWT tokens" <> metavar "SECRET" <> value "secret" <> showDefault))
   <*> option auto  (long "pool"       <> short 'o' <> help "max connections in database pool" <> metavar "COUNT" <> value 10 <> showDefault)
   <*> (readMay <$> strOption  (long "max-rows"   <> short 'm' <> help "max rows in response" <> metavar "COUNT" <> value "infinity" <> showDefault))
+  <*> (optional . map toS . strOption) (long "pre-request"  <> help "schema-qualified name of proc to call to validate requests" <> metavar "FUNCTION")
   <*> pure False
 
 defaultCorsPolicy :: CorsResourcePolicy

src/PostgREST/Middleware.hs

@@ -7,33 +7,46 @@ import           Data.Aeson                    (Value (..))
 import qualified Data.HashMap.Strict           as M
 import qualified Hasql.Transaction             as H
 
-import           Network.HTTP.Types.Status     (status400)
+import           Network.HTTP.Types.Status     (unauthorized401, status500)
-import           Network.Wai                   (Application, Response)
+import           Network.Wai                   (Application, Response,
+                                                responseLBS)
 import           Network.Wai.Middleware.Cors   (cors)
 import           Network.Wai.Middleware.Gzip   (def, gzip)
 import           Network.Wai.Middleware.Static (only, staticPolicy)
 
-import           PostgREST.ApiRequest          (ApiRequest(..))
+import           PostgREST.ApiRequest          (ApiRequest(..), ContentType(..),
-import           PostgREST.Auth                (claimsToSQL)
+                                                ctToHeader)
+import           PostgREST.Auth                (claimsToSQL, JWTAttempt(..))
 import           PostgREST.Config              (AppConfig (..), corsPolicy)
 import           PostgREST.Error               (errResponse)
-import           Data.Text
 
 import           Protolude                     hiding (concat, null)
 
-runWithClaims :: AppConfig -> Either Text (M.HashMap Text Value) ->
+runWithClaims :: AppConfig -> JWTAttempt ->
                  (ApiRequest -> H.Transaction Response) ->
                  ApiRequest -> H.Transaction Response
 runWithClaims conf eClaims app req =
   case eClaims of
-    Left e -> clientErr e
+    JWTExpired -> return $ unauthed "JWT expired"
-    Right claims -> do
+    JWTInvalid -> return $ unauthed "JWT invalid"
-          -- role claim defaults to anon if not specified in jwt
+    JWTMissingSecret -> return $ errResponse status500 "Server lacks JWT secret"
-          H.sql . mconcat . claimsToSQL $ M.union claims (M.singleton "role" anon)
+    JWTClaims claims -> do
-          app req
+      -- role claim defaults to anon if not specified in jwt
+      let setClaims = claimsToSQL (M.union claims (M.singleton "role" anon))
+      H.sql $ mconcat setClaims
+      mapM_ H.sql customReqCheck
+      app req
   where
     anon = String . toS $ configAnonRole conf
-    clientErr = return . errResponse status400
+    customReqCheck = (\f -> "select " <> toS f <> "();") <$> configReqCheck conf
+    unauthed message = responseLBS unauthorized401
+      [ ctToHeader CTApplicationJSON
+      , ( "WWW-Authenticate"
+        , "Bearer error=\"invalid_token\", " <>
+          "error_description=\"" <> message <> "\""
+        )
+      ]
+      (toS $ "{\"message\":\""<>message<>"\"}")
 
 defaultMiddle :: Application -> Application
 defaultMiddle =

test/Feature/AuthSpec.hs

@@ -1,6 +1,7 @@
 module Feature.AuthSpec where
 
 -- {{{ Imports
+import Text.Heredoc
 import Test.Hspec
 import Test.Hspec.Wai
 import Test.Hspec.Wai.JSON
@@ -12,6 +13,7 @@ import Network.Wai (Application)
 
 spec :: SpecWith Application
 spec = describe "authorization" $ do
+  let single = ("Prefer","plurality=singular")
 
   it "denies access to tables that anonymous does not own" $
     get "/authors_only" `shouldRespondWith` ResponseMatcher {
@@ -38,17 +40,18 @@ spec = describe "authorization" $ do
       }
 
   it "returns jwt functions as jwt tokens" $
-    post "/rpc/login" [json| { "id": "jdoe", "pass": "1234" } |]
+    request methodPost "/rpc/login" [single]
+      [json| { "id": "jdoe", "pass": "1234" } |]
       `shouldRespondWith` ResponseMatcher {
-          matchBody = Just [json| {"token":"eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJyb2xlIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIiwiaWQiOiJqZG9lIn0.y4vZuu1dDdwAl0-S00MCRWRYMlJ5YAMSir6Es6WtWx0"} |]
+          matchBody = Just [json| {"token":"eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJyb2xuYW1lIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIiwiaWQiOiJqZG9lIn0.P2G9EVSVI22MWxXWFuhEYd9BZerLS1WDlqzdqplM15s"} |]
         , matchStatus = 200
         , matchHeaders = ["Content-Type" <:> "application/json; charset=utf-8"]
         }
 
   it "sql functions can encode custom and standard claims" $
-    post "/rpc/jwt_test" "{}"
+    request methodPost  "/rpc/jwt_test" [single] "{}"
       `shouldRespondWith` ResponseMatcher {
-          matchBody = Just [json| {"token":"eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJzdWIiOiJmdW4iLCJqdGkiOiJmb28iLCJuYmYiOjEzMDA4MTkzODAsImV4cCI6MTMwMDgxOTM4MCwiaHR0cDovL3Bvc3RncmVzdC5jb20vZm9vIjp0cnVlLCJpc3MiOiJqb2UiLCJyb2xlIjoicG9zdGdyZXN0X3Rlc3QiLCJpYXQiOjEzMDA4MTkzODAsImF1ZCI6ImV2ZXJ5b25lIn0._tQCF79-ZZGMlLktd3csM_bVaiMg7A8YvIb6K2hcu5w"} |]
+          matchBody = Just [json| {"token":"eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJpc3MiOiJqb2UiLCJzdWIiOiJmdW4iLCJhdWQiOiJldmVyeW9uZSIsImV4cCI6MTMwMDgxOTM4MCwibmJmIjoxMzAwODE5MzgwLCJpYXQiOjEzMDA4MTkzODAsImp0aSI6ImZvbyIsInJvbGUiOiJwb3N0Z3Jlc3RfdGVzdCIsImh0dHA6Ly9wb3N0Z3Jlc3QuY29tL2ZvbyI6dHJ1ZX0.IHF16ZSU6XTbOnUWO8CCpUn2fJwt8P00rlYVyXQjpWc"} |]
         , matchStatus = 200
         , matchHeaders = ["Content-Type" <:> "application/json; charset=utf-8"]
         }
@@ -80,26 +83,72 @@ spec = describe "authorization" $ do
   it "fails with an expired token" $ do
     let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJleHAiOjE0NDY2NzgxNDksInJvbGUiOiJwb3N0Z3Jlc3RfdGVzdF9hdXRob3IiLCJpZCI6Impkb2UifQ.enk_qZ_u6gZsXY4R8bREKB_HNExRpM0lIWSLktk9JJQ"
     request methodGet "/authors_only" [auth] ""
-      `shouldRespondWith` 400
+      `shouldRespondWith` ResponseMatcher {
+          matchBody = Nothing
+        , matchStatus = 401
+        , matchHeaders = [
+            "WWW-Authenticate" <:>
+            "Bearer error=\"invalid_token\", error_description=\"JWT expired\""
+          ]
+        }
 
   it "hides tables from users with invalid JWT" $ do
     let auth = authHeaderJWT "ey9zdGdyZXN0X3Rlc3RfYXV0aG9yIiwiaWQiOiJqZG9lIn0.y4vZuu1dDdwAl0-S00MCRWRYMlJ5YAMSir6Es6WtWx0"
     request methodGet "/authors_only" [auth] ""
-      `shouldRespondWith` 400
+      `shouldRespondWith` ResponseMatcher {
+          matchBody = Nothing
+        , matchStatus = 401
+        , matchHeaders = [
+            "WWW-Authenticate" <:>
+            "Bearer error=\"invalid_token\", error_description=\"JWT invalid\""
+          ]
+        }
 
   it "should fail when jwt contains no claims" $ do
-    let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.e30.MKYc_lOECtB0LJOiykilAdlHodB-I0_id2qHKq35dmc"
+    let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.e30.lu-rG8aSCiw-aOlN0IxpRGz5r7Jwq7K9r3tuMPUpytI"
     request methodGet "/authors_only" [auth] ""
-      `shouldRespondWith` 400
+      `shouldRespondWith` 401
 
   it "hides tables from users with JWT that contain no claims about role" $ do
-    let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJpZCI6Impkb2UifQ.zyohGMnrDy4_8eJTl6I2AUXO3MeCCiwR24aGWRkTE9o"
+    let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJpZCI6Impkb2UifQ.Jneso9X519Vh0z7i9PbXIu7W1HEoq9RRw9BBbyQKFCQ"
     request methodGet "/authors_only" [auth] ""
-      `shouldRespondWith` 400
+      `shouldRespondWith` 401
 
-  it "recovers after 400 error with logged in user" $ do
+  it "recovers after 401 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
+
+  describe "custom pre-request proc acting on id claim" $ do
+
+    it "able to switch to postgrest_test_author role (id=1)" $
+      let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJpZCI6MX0.mI2HNoOum6xM3sc4oHLxU4yLv-_WV5W1kqBfY_wEvLw" in
+      request methodPost "/rpc/get_current_user" [auth]
+        [json| {} |]
+         `shouldRespondWith` ResponseMatcher {
+            matchBody    = Just [str|"postgrest_test_author"|]
+          , matchStatus = 200
+          , matchHeaders = []
+          }
+
+    it "able to switch to postgrest_test_default_role (id=2)" $
+      let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJpZCI6Mn0.W7jLsG-zswM91AJkCvZeIMHrnz7_6ceY2jnscVl3Yhk" in
+      request methodPost "/rpc/get_current_user" [auth]
+        [json| {} |]
+         `shouldRespondWith` ResponseMatcher {
+            matchBody    = Just [str|"postgrest_test_default_role"|]
+          , matchStatus = 200
+          , matchHeaders = []
+          }
+
+    it "raises error (id=3)" $
+      let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJpZCI6M30.15Gy8PezQhJIaHYDJVLa-Gmz9T3sJnW66EKAYIsXc7c" in
+      request methodPost "/rpc/get_current_user" [auth]
+        [json| {} |]
+         `shouldRespondWith` ResponseMatcher {
+            matchBody    = Just [str|{"hint":"Please contact administrator","details":null,"code":"P0001","message":"Disabled ID --> 3"}|]
+          , matchStatus = 400
+          , matchHeaders = []
+          }

test/Feature/NoJwtSpec.hs

@@ -0,0 +1,23 @@
+module Feature.NoJwtSpec where
+
+-- {{{ Imports
+import Test.Hspec
+import Test.Hspec.Wai
+import Network.HTTP.Types
+
+import SpecHelper
+import Network.Wai (Application)
+-- }}}
+
+spec :: SpecWith Application
+spec = describe "server started without JWT secret" $ do
+
+  -- this test will stop working 9999999999s after the UNIX EPOCH
+  it "responds with error on attempted auth" $ do
+    let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJleHAiOjk5OTk5OTk5OTksInJvbGUiOiJwb3N0Z3Jlc3RfdGVzdF9hdXRob3IiLCJpZCI6Impkb2UifQ.QaPPLWTuyydMu_q7H4noMT7Lk6P4muet1OpJXF6ofhc"
+    request methodGet "/authors_only" [auth] ""
+      `shouldRespondWith` 500
+
+  it "behaves normally when user does not attempt auth" $
+    request methodGet "/items" [] ""
+      `shouldRespondWith` 200

test/Main.hs

@@ -7,14 +7,17 @@ import qualified Hasql.Pool as P
 
 import PostgREST.DbStructure (getDbStructure)
 import PostgREST.App (postgrest)
+import Control.AutoUpdate
 import Data.IORef
 import Data.String.Conversions (cs)
+import Data.Time.Clock.POSIX   (getPOSIXTime)
 
 import qualified Feature.AuthSpec
 import qualified Feature.ConcurrentSpec
 import qualified Feature.CorsSpec
 import qualified Feature.DeleteSpec
 import qualified Feature.InsertSpec
+import qualified Feature.NoJwtSpec
 import qualified Feature.QueryLimitedSpec
 import qualified Feature.QuerySpec
 import qualified Feature.RangeSpec
@@ -27,13 +30,18 @@ main = do
   setupDb
 
   pool <- P.acquire (3, 10, cs testDbConn)
+  -- ask for the OS time at most once per second
+  getTime <- mkAutoUpdate
+    defaultUpdateSettings { updateAction = getPOSIXTime }
+
 
   result <- P.use pool $ getDbStructure "test"
   refDbStructure <- newIORef $ either (error.show) id result
-  let withApp = return $ postgrest testCfg refDbStructure pool
+  let withApp = return $ postgrest testCfg refDbStructure pool getTime
-      ltdApp  = return $ postgrest testLtdRowsCfg refDbStructure pool
+      ltdApp  = return $ postgrest testLtdRowsCfg refDbStructure pool getTime
-      unicodeApp = return $ postgrest testUnicodeCfg refDbStructure pool
+      unicodeApp = return $ postgrest testUnicodeCfg refDbStructure pool getTime
-      proxyApp = return $ postgrest testProxyCfg refDbStructure pool
+      proxyApp = return $ postgrest testProxyCfg refDbStructure pool getTime
+      noJwtApp = return $ postgrest testCfgNoJWT refDbStructure pool getTime
 
   hspec $ do
     mapM_ (beforeAll_ resetDb . before withApp) specs
@@ -50,6 +58,10 @@ main = do
     beforeAll_ resetDb . before proxyApp $
       describe "Feature.ProxySpec" Feature.ProxySpec.spec
 
+    -- this test runs without a JWT secret
+    beforeAll_ resetDb . before noJwtApp $
+      describe "Feature.NoJwtSpec" Feature.NoJwtSpec.spec
+
  where
   specs = map (uncurry describe) [
       ("Feature.AuthSpec"         , Feature.AuthSpec.spec)

test/SpecHelper.hs

@@ -8,7 +8,6 @@ import Data.CaseInsensitive (CI(..))
 import Text.Regex.TDFA ((=~))
 import qualified Data.ByteString.Char8 as BS
 import System.Process (readProcess)
-import Web.JWT (secret)
 
 import PostgREST.Config (AppConfig(..))
 
@@ -52,25 +51,31 @@ testDbConn = "postgres://postgrest_test_authenticator@localhost:5432/postgrest_t
 
 testCfg :: AppConfig
 testCfg =
-  AppConfig testDbConn "postgrest_test_anonymous" Nothing "test" "localhost" 3000 (secret "safe") 10 Nothing True
+  AppConfig testDbConn "postgrest_test_anonymous" Nothing "test" "localhost" 3000 (Just "safe") 10 Nothing (Just "test.switch_role") True
+
+testCfgNoJWT :: AppConfig
+testCfgNoJWT =
+  AppConfig testDbConn "postgrest_test_anonymous" Nothing "test" "localhost" 3000 Nothing 10 Nothing Nothing True
 
 testUnicodeCfg :: AppConfig
 testUnicodeCfg =
-  AppConfig testDbConn "postgrest_test_anonymous" Nothing "تست" "localhost" 3000 (secret "safe") 10 Nothing True
+  AppConfig testDbConn "postgrest_test_anonymous" Nothing "تست" "localhost" 3000 (Just "safe") 10 Nothing Nothing True
 
 testLtdRowsCfg :: AppConfig
 testLtdRowsCfg =
-  AppConfig testDbConn "postgrest_test_anonymous" Nothing "test" "localhost" 3000 (secret "safe") 10 (Just 2) True
+  AppConfig testDbConn "postgrest_test_anonymous" Nothing "test" "localhost" 3000 (Just "safe") 10 (Just 2) Nothing True
 
 testProxyCfg :: AppConfig
 testProxyCfg =
-  AppConfig testDbConn "postgrest_test_anonymous" (Just "https://postgrest.com/openapi.json") "test" "localhost" 3000 (secret "safe") 10 Nothing True
+  AppConfig testDbConn "postgrest_test_anonymous" (Just "https://postgrest.com/openapi.json") "test" "localhost" 3000 (Just "safe") 10 Nothing Nothing True
 
 setupDb :: IO ()
 setupDb = do
   void $ readProcess "psql" ["-d", "postgres", "-a", "-f", "test/fixtures/database.sql"] []
+  void $ readProcess "psql" ["-d", "postgrest_test", "-a", "-c", "CREATE EXTENSION IF NOT EXISTS pgcrypto;"] []
   loadFixture "roles"
   loadFixture "schema"
+  loadFixture "jwt"
   loadFixture "privileges"
   resetDb
 

test/fixtures/database.sql

@@ -2,3 +2,5 @@ DROP DATABASE IF EXISTS postgrest_test;
 DROP ROLE IF EXISTS postgrest_test;
 CREATE USER postgrest_test createdb createrole;
 CREATE DATABASE postgrest_test OWNER postgrest_test;
+
+ALTER DATABASE postgrest_test SET postgrest.claims.id = '-1';

test/fixtures/jwt.sql

@@ -0,0 +1,64 @@
+-- From michelp/pgjwt commit c02bbd3
+BEGIN;
+DROP SCHEMA IF EXISTS jwt CASCADE;
+CREATE SCHEMA jwt;
+
+
+CREATE OR REPLACE FUNCTION jwt.url_encode(data bytea) RETURNS text LANGUAGE sql AS $$
+    SELECT translate(encode(data, 'base64'), E'+/=\n', '-_');
+$$;
+
+
+CREATE OR REPLACE FUNCTION jwt.url_decode(data text) RETURNS bytea LANGUAGE sql AS $$
+WITH t AS (SELECT translate(data, '-_', '+/')),
+     rem AS (SELECT length((SELECT * FROM t)) % 4) -- compute padding size
+    SELECT decode(
+        (SELECT * FROM t) ||
+        CASE WHEN (SELECT * FROM rem) > 0
+           THEN repeat('=', (4 - (SELECT * FROM rem)))
+           ELSE '' END,
+    'base64');
+$$;
+
+
+CREATE OR REPLACE FUNCTION jwt.algorithm_sign(signables text, secret text, algorithm text)
+RETURNS text LANGUAGE sql AS $$
+WITH
+  alg AS (
+    SELECT CASE
+      WHEN algorithm = 'HS256' THEN 'sha256'
+      WHEN algorithm = 'HS384' THEN 'sha384'
+      WHEN algorithm = 'HS512' THEN 'sha512'
+      ELSE '' END)  -- hmac throws error
+SELECT jwt.url_encode(hmac(signables, secret, (select * FROM alg)));
+$$;
+
+
+CREATE OR REPLACE FUNCTION jwt.sign(payload json, secret text, algorithm text DEFAULT 'HS256')
+RETURNS text LANGUAGE sql AS $$
+WITH
+  header AS (
+    SELECT jwt.url_encode(convert_to('{"alg":"' || algorithm || '","typ":"JWT"}', 'utf8'))
+    ),
+  payload AS (
+    SELECT jwt.url_encode(convert_to(payload::text, 'utf8'))
+    ),
+  signables AS (
+    SELECT (SELECT * FROM header) || '.' || (SELECT * FROM payload)
+    )
+SELECT
+    (SELECT * FROM signables)
+    || '.' ||
+    jwt.algorithm_sign((SELECT * FROM signables), secret, algorithm);
+$$;
+
+
+CREATE OR REPLACE FUNCTION jwt.verify(token text, secret text, algorithm text DEFAULT 'HS256')
+RETURNS table(header json, payload json, valid boolean) LANGUAGE sql AS $$
+  SELECT
+    convert_from(jwt.url_decode(r[1]), 'utf8')::json AS header,
+    convert_from(jwt.url_decode(r[2]), 'utf8')::json AS payload,
+    r[3] = jwt.algorithm_sign(r[1] || '.' || r[2], secret, algorithm) AS valid
+  FROM regexp_split_to_array(token, '\.') r;
+$$;
+COMMIT;

test/fixtures/privileges.sql

@@ -2,6 +2,7 @@
 GRANT USAGE ON SCHEMA
       postgrest
     , test
+    , jwt
     , "تست"
 TO postgrest_test_anonymous;
 

test/fixtures/schema.sql

@@ -49,29 +49,11 @@ CREATE EXTENSION IF NOT EXISTS plpgsql WITH SCHEMA pg_catalog;
 SET search_path = public, pg_catalog;
 
 --
--- Name: jwt_claims; Type: TYPE; Schema: public; Owner: -
+-- Name: jwt_token; Type: TYPE; Schema: public; Owner: -
 --
 
-CREATE TYPE jwt_claims AS (
+CREATE TYPE jwt_token AS (
-	role text,
+	token text
-	id text
-);
-
---
--- Name: big_jwt_claims; Type: TYPE; Schema: public; Owner: -
---
-
-CREATE TYPE big_jwt_claims AS (
-  iss text,
-  sub text,
-  aud text,
-  exp integer,
-  nbf integer,
-  iat integer,
-  jti text,
-
-  role text,
-  "http://postgrest.com/foo" boolean
 );
 
 
@@ -208,10 +190,17 @@ $$;
 -- Name: login(text, text); Type: FUNCTION; Schema: test; Owner: -
 --
 
-CREATE FUNCTION login(id text, pass text) RETURNS public.jwt_claims
+CREATE FUNCTION login(id text, pass text) RETURNS public.jwt_token
     LANGUAGE sql SECURITY DEFINER
     AS $$
-SELECT rolname::text, id::text FROM postgrest.auth WHERE id = id AND pass = pass;
+SELECT jwt.sign(
+    row_to_json(r), 'safe'
+  ) as token
+  FROM (
+    SELECT rolname::text, id::text
+      FROM postgrest.auth
+     WHERE id = id AND pass = pass
+  ) r;
 $$;
 
 
@@ -234,16 +223,46 @@ $_$;
 -- Name: jwt_test(); Type: FUNCTION; Schema: test; Owner: -
 --
 
-CREATE FUNCTION jwt_test() RETURNS public.big_jwt_claims
+CREATE FUNCTION jwt_test() RETURNS public.jwt_token
     LANGUAGE sql SECURITY DEFINER
     AS $$
-SELECT 'joe'::text as iss, 'fun'::text as sub, 'everyone'::text as aud,
+SELECT jwt.sign(
+    row_to_json(r), 'safe'
+  ) as token
+  FROM (
+    SELECT 'joe'::text as iss, 'fun'::text as sub, 'everyone'::text as aud,
        1300819380 as exp, 1300819380 as nbf, 1300819380 as iat,
        'foo'::text as jti, 'postgrest_test'::text as role,
-       true as "http://postgrest.com/foo";
+       true as "http://postgrest.com/foo"
+  ) r;
 $$;
 
 
+CREATE OR REPLACE FUNCTION switch_role() RETURNS void
+  LANGUAGE plpgsql
+  AS $$
+declare
+  user_id text;
+begin
+  user_id = current_setting('postgrest.claims.id')::text;
+  if user_id = '1'::text then
+    execute 'set local role postgrest_test_author';
+  elseif user_id = '2'::text then
+    execute 'set local role postgrest_test_default_role';
+  elseif user_id = '3'::text then
+    RAISE EXCEPTION 'Disabled ID --> %', user_id USING HINT = 'Please contact administrator';
+  /* else */
+  /*   execute 'set local role postgrest_test_anonymous'; */
+  end if;
+end
+$$;
+
+CREATE FUNCTION get_current_user() RETURNS text
+  LANGUAGE sql
+  AS $$
+SELECT current_user::text;
+$$;
+
 --
 -- Name: reveal_big_jwt(); Type: FUNCTION; Schema: test; Owner: -
 --