correct: fail on invalid types of registered JWT claims (exp, nbf, iat, aud)

postgrest.cabal

@@ -267,6 +267,7 @@ test-suite spec
                     , hspec-wai         >= 0.10 && < 0.12
                     , hspec-wai-json    >= 0.10 && < 0.12
                     , http-types        >= 0.12.3 && < 0.13
+                    , jose-jwt          >= 0.9.6 && < 0.11
                     , lens              >= 4.14 && < 5.3
                     , lens-aeson        >= 1.0.1 && < 1.3
                     , monad-control     >= 1.0.1 && < 1.1

src/PostgREST/Auth.hs

@@ -82,39 +82,39 @@ parseToken AppConfig{..} (Just tkn) time = do
 
       verifyClaims :: JWT.JwtContent -> Either JwtError JSON.Value
       verifyClaims (JWT.Jws (_, claims)) = case JSON.decodeStrict claims of
-        Nothing                    -> Left $ JwtClaimsError "Parsing claims failed"
+        Just jclaims@(JSON.Object mclaims) ->
-        Just (JSON.Object mclaims)
+          verifyClaim mclaims "exp" isValidExpClaim "JWT expired" >>
-          | failedExpClaim mclaims -> Left $ JwtClaimsError "JWT expired"
+          verifyClaim mclaims "nbf" isValidNbfClaim "JWT not yet valid" >>
-          | failedNbfClaim mclaims -> Left $ JwtClaimsError "JWT not yet valid"
+          verifyClaim mclaims "iat" isValidIatClaim "JWT issued at future" >>
-          | failedIatClaim mclaims -> Left $ JwtClaimsError "JWT issued at future"
+          verifyClaim mclaims "aud" isValidAudClaim "JWT not in audience" >>
-          | failedAudClaim mclaims -> Left $ JwtClaimsError "JWT not in audience"
+          return jclaims
-        Just jclaims               -> Right jclaims
+        _ -> Left $ JwtClaimsError "Parsing claims failed"
       -- TODO: We could enable JWE support here (encrypted tokens)
-      verifyClaims _                = Left $ JwtDecodeError "Unsupported token type"
+      verifyClaims _ = Left $ JwtDecodeError "Unsupported token type"
+
+      verifyClaim mclaims claim func err = do
+        isValid <- maybe (Right True) func (KM.lookup claim mclaims)
+        unless isValid $ Left $ JwtClaimsError err
 
       allowedSkewSeconds = 30 :: Int64
       now = floor . nominalDiffTimeToSeconds $ utcTimeToPOSIXSeconds time
       sciToInt = fromMaybe 0 . Sci.toBoundedInteger
 
-      failedExpClaim :: KM.KeyMap JSON.Value -> Bool
+      isValidExpClaim :: JSON.Value -> Either JwtError Bool
-      failedExpClaim mclaims = case KM.lookup "exp" mclaims of
+      isValidExpClaim (JSON.Number secs) = Right $ now <= (sciToInt secs + allowedSkewSeconds)
-        Just (JSON.Number secs) -> now > (sciToInt secs + allowedSkewSeconds)
+      isValidExpClaim _ = Left $ JwtClaimsError "The JWT 'exp' claim must be a number"
-        _                       -> False
 
-      failedNbfClaim :: KM.KeyMap JSON.Value -> Bool
+      isValidNbfClaim :: JSON.Value -> Either JwtError Bool
-      failedNbfClaim mclaims = case KM.lookup "nbf" mclaims of
+      isValidNbfClaim (JSON.Number secs) = Right $ now >= (sciToInt secs - allowedSkewSeconds)
-        Just (JSON.Number secs) -> now < (sciToInt secs - allowedSkewSeconds)
+      isValidNbfClaim _ = Left $ JwtClaimsError "The JWT 'nbf' claim must be a number"
-        _                       -> False
 
-      failedIatClaim :: KM.KeyMap JSON.Value -> Bool
+      isValidIatClaim :: JSON.Value -> Either JwtError Bool
-      failedIatClaim mclaims = case KM.lookup "iat" mclaims of
+      isValidIatClaim (JSON.Number secs) = Right $ now >= (sciToInt secs - allowedSkewSeconds)
-        Just (JSON.Number secs) -> now < (sciToInt secs - allowedSkewSeconds)
+      isValidIatClaim _ = Left $ JwtClaimsError "The JWT 'iat' claim must be a number"
-        _                       -> False
 
-      failedAudClaim :: KM.KeyMap JSON.Value -> Bool
+      isValidAudClaim :: JSON.Value -> Either JwtError Bool
-      failedAudClaim mclaims = case KM.lookup "aud" mclaims of
+      isValidAudClaim (JSON.String str) = Right $ maybe (const True) (==) configJwtAudience str
-        Just (JSON.String str) -> maybe (const False) (/=) configJwtAudience str
+      isValidAudClaim _ = Left $ JwtClaimsError "The JWT 'aud' claim must be a string or an array of strings"
-        _                      -> False
 
 parseClaims :: Monad m =>
   AppConfig -> JSON.Value -> ExceptT Error m AuthResult

test/spec/Feature/Auth/AuthSpec.hs

@@ -137,6 +137,66 @@ spec = describe "authorization" $ do
     request methodGet "/authors_only" [auth] ""
       `shouldRespondWith` 200
 
+  it "fails when the exp claim is not a number" $ do
+    let jwtPayload = [json|
+          {
+            "exp": "invalid",
+            "role": "postgrest_test_author"
+          }|]
+        auth = authHeaderJWT $ generateJWT jwtPayload
+    request methodGet "/authors_only" [auth] ""
+      `shouldRespondWith`
+        [json|{"code":"PGRST303","details":null,"hint":null,"message":"The JWT 'exp' claim must be a number"}|]
+        { matchStatus = 401 }
+
+  it "fails when the nbf claim is not a number" $ do
+    let jwtPayload = [json|
+          {
+            "nbf": "invalid",
+            "role": "postgrest_test_author"
+          }|]
+        auth = authHeaderJWT $ generateJWT jwtPayload
+    request methodGet "/authors_only" [auth] ""
+      `shouldRespondWith`
+        [json|{"code":"PGRST303","details":null,"hint":null,"message":"The JWT 'nbf' claim must be a number"}|]
+        { matchStatus = 401 }
+
+  it "fails when the iat claim is not a number" $ do
+    let jwtPayload = [json|
+          {
+            "iat": "invalid",
+            "role": "postgrest_test_author"
+          }|]
+        auth = authHeaderJWT $ generateJWT jwtPayload
+    request methodGet "/authors_only" [auth] ""
+      `shouldRespondWith`
+        [json|{"code":"PGRST303","details":null,"hint":null,"message":"The JWT 'iat' claim must be a number"}|]
+        { matchStatus = 401 }
+
+  it "fails when the aud claim has a single value and it's not a string" $ do
+    let jwtPayload = [json|
+          {
+            "aud": {"invalid": "value"},
+            "role": "postgrest_test_author"
+          }|]
+        auth = authHeaderJWT $ generateJWT jwtPayload
+    request methodGet "/authors_only" [auth] ""
+      `shouldRespondWith`
+        [json|{"code":"PGRST303","details":null,"hint":null,"message":"The JWT 'aud' claim must be a string or an array of strings"}|]
+        { matchStatus = 401 }
+
+  it "fails when the aud claim is an array but it has non-string elements" $ do
+    let jwtPayload = [json|
+          {
+            "aud": [{"invalid": "value"}, "test"],
+            "role": "postgrest_test_author"
+          }|]
+        auth = authHeaderJWT $ generateJWT jwtPayload
+    request methodGet "/authors_only" [auth] ""
+      `shouldRespondWith`
+        [json|{"code":"PGRST303","details":null,"hint":null,"message":"The JWT 'aud' claim must be a string or an array of strings"}|]
+        { matchStatus = 401 }
+
   describe "custom pre-request proc acting on id claim" $ do
 
     it "able to switch to postgrest_test_author role (id=1)" $

test/spec/SpecHelper.hs

@@ -10,6 +10,9 @@ import qualified Data.ByteString.Lazy   as BL
 import qualified Data.Map.Strict        as M
 import           Data.Scientific        (toRealFloat)
 import qualified Data.Set               as S
+import qualified Jose.Jwa               as JWT
+import qualified Jose.Jws               as JWT
+import qualified Jose.Jwt               as JWT
 
 import Data.Aeson           ((.=))
 import Data.CaseInsensitive (CI (..), mk, original)
@@ -197,19 +200,17 @@ testPlanEnabledCfg = baseCfg { configDbPlanEnabled = True }
 
 testCfgBinaryJWT :: AppConfig
 testCfgBinaryJWT =
-  let secret = B64.decodeLenient "cmVhbGx5cmVhbGx5cmVhbGx5cmVhbGx5dmVyeXNhZmU=" in
   baseCfg {
-    configJwtSecret = Just secret
+    configJwtSecret = Just generateSecret
-  , configJWKS = rightToMaybe $ parseSecret secret
+  , configJWKS = rightToMaybe $ parseSecret generateSecret
   }
 
 testCfgAudienceJWT :: AppConfig
 testCfgAudienceJWT =
-  let secret = B64.decodeLenient "cmVhbGx5cmVhbGx5cmVhbGx5cmVhbGx5dmVyeXNhZmU=" in
   baseCfg {
-    configJwtSecret = Just secret
+    configJwtSecret = Just generateSecret
   , configJwtAudience = Just "youraudience"
-  , configJWKS = rightToMaybe $ parseSecret secret
+  , configJWKS = rightToMaybe $ parseSecret generateSecret
   }
 
 testCfgAsymJWK :: AppConfig
@@ -291,6 +292,13 @@ authHeader typ creds =
 authHeaderJWT :: BS.ByteString -> Header
 authHeaderJWT = authHeader "Bearer"
 
+generateSecret :: ByteString
+generateSecret = B64.decodeLenient "cmVhbGx5cmVhbGx5cmVhbGx5cmVhbGx5dmVyeXNhZmU="
+
+generateJWT :: BL.ByteString -> ByteString
+generateJWT claims =
+  either mempty JWT.unJwt $ JWT.hmacEncode JWT.HS256 generateSecret (BL.toStrict claims)
+
 -- | Tests whether the text can be parsed as a json object containing
 -- the key "message", and optional keys "details", "hint", "code",
 -- and no extraneous keys