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

This commit is contained in:
Laurence Isla
2025-05-07 21:54:32 +00:00
parent 066b136597
commit b3bff90d68
4 changed files with 99 additions and 30 deletions
+1
View File
@@ -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
+24 -24
View File
@@ -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 (JSON.Object mclaims)
| failedExpClaim mclaims -> Left $ JwtClaimsError "JWT expired"
| failedNbfClaim mclaims -> Left $ JwtClaimsError "JWT not yet valid"
| failedIatClaim mclaims -> Left $ JwtClaimsError "JWT issued at future"
| failedAudClaim mclaims -> Left $ JwtClaimsError "JWT not in audience"
Just jclaims -> Right jclaims
Just jclaims@(JSON.Object mclaims) ->
verifyClaim mclaims "exp" isValidExpClaim "JWT expired" >>
verifyClaim mclaims "nbf" isValidNbfClaim "JWT not yet valid" >>
verifyClaim mclaims "iat" isValidIatClaim "JWT issued at future" >>
verifyClaim mclaims "aud" isValidAudClaim "JWT not in audience" >>
return 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
failedExpClaim mclaims = case KM.lookup "exp" mclaims of
Just (JSON.Number secs) -> now > (sciToInt secs + allowedSkewSeconds)
_ -> False
isValidExpClaim :: JSON.Value -> Either JwtError Bool
isValidExpClaim (JSON.Number secs) = Right $ now <= (sciToInt secs + allowedSkewSeconds)
isValidExpClaim _ = Left $ JwtClaimsError "The JWT 'exp' claim must be a number"
failedNbfClaim :: KM.KeyMap JSON.Value -> Bool
failedNbfClaim mclaims = case KM.lookup "nbf" mclaims of
Just (JSON.Number secs) -> now < (sciToInt secs - allowedSkewSeconds)
_ -> False
isValidNbfClaim :: JSON.Value -> Either JwtError Bool
isValidNbfClaim (JSON.Number secs) = Right $ now >= (sciToInt secs - allowedSkewSeconds)
isValidNbfClaim _ = Left $ JwtClaimsError "The JWT 'nbf' claim must be a number"
failedIatClaim :: KM.KeyMap JSON.Value -> Bool
failedIatClaim mclaims = case KM.lookup "iat" mclaims of
Just (JSON.Number secs) -> now < (sciToInt secs - allowedSkewSeconds)
_ -> False
isValidIatClaim :: JSON.Value -> Either JwtError Bool
isValidIatClaim (JSON.Number secs) = Right $ now >= (sciToInt secs - allowedSkewSeconds)
isValidIatClaim _ = Left $ JwtClaimsError "The JWT 'iat' claim must be a number"
failedAudClaim :: KM.KeyMap JSON.Value -> Bool
failedAudClaim mclaims = case KM.lookup "aud" mclaims of
Just (JSON.String str) -> maybe (const False) (/=) configJwtAudience str
_ -> False
isValidAudClaim :: JSON.Value -> Either JwtError Bool
isValidAudClaim (JSON.String str) = Right $ maybe (const True) (==) configJwtAudience str
isValidAudClaim _ = Left $ JwtClaimsError "The JWT 'aud' claim must be a string or an array of strings"
parseClaims :: Monad m =>
AppConfig -> JSON.Value -> ExceptT Error m AuthResult
+60
View File
@@ -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)" $
+14 -6
View File
@@ -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
, configJWKS = rightToMaybe $ parseSecret secret
configJwtSecret = Just generateSecret
, 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