fix: improve jwt errors

This commit is contained in:
Taimoor Zaeem
2025-03-13 00:20:54 +01:00
committed by Steve Chavez
parent 4819520e3a
commit 36b6a2c86b
7 changed files with 118 additions and 44 deletions
+34 -20
View File
@@ -23,6 +23,7 @@ import qualified Data.Aeson.Key as K
import qualified Data.Aeson.KeyMap as KM
import qualified Data.Aeson.Types as JSON
import qualified Data.ByteString as BS
import qualified Data.ByteString.Internal as BS
import qualified Data.ByteString.Lazy.Char8 as LBS
import qualified Data.Scientific as Sci
import qualified Data.Text as T
@@ -54,33 +55,42 @@ import Protolude
-- | Receives the JWT secret and audience (from config) and a JWT and returns a
-- JSON object of JWT claims.
parseToken :: AppConfig -> ByteString -> UTCTime -> ExceptT Error IO JSON.Value
parseToken _ "" _ = return JSON.emptyObject
parseToken AppConfig{..} token time = do
secret <- liftEither . maybeToRight (JwtErr JwtTokenMissing) $ configJWKS
eitherContent <- liftIO $ JWT.decode (JWT.keys secret) Nothing token
parseToken :: AppConfig -> Maybe ByteString -> UTCTime -> ExceptT Error IO JSON.Value
parseToken _ Nothing _ = return JSON.emptyObject
parseToken _ (Just "") _ = throwE . JwtErr $ JwtDecodeError "Empty JWT is sent in Authorization header"
parseToken AppConfig{..} (Just tkn) time = do
secret <- liftEither . maybeToRight (JwtErr JwtSecretMissing) $ configJWKS
tknWith3Parts <- liftEither $ hasThreeParts tkn
eitherContent <- liftIO $ JWT.decode (JWT.keys secret) Nothing tknWith3Parts
content <- liftEither . mapLeft (JwtErr . jwtDecodeError) $ eitherContent
liftEither $ mapLeft JwtErr $ verifyClaims content
where
-- TODO: Improve errors, those were just taken as-is from hs-jose to avoid
-- breaking changes.
hasThreeParts :: ByteString -> Either Error ByteString
hasThreeParts token = case length $ BS.split (BS.c2w '.') token of
3 -> Right token
n -> Left $ JwtErr $ JwtDecodeError ("Expected 3 parts in JWT; got " <> show n)
jwtDecodeError :: JWT.JwtError -> JwtError
jwtDecodeError (JWT.KeyError _) = JwtTokenInvalid "JWSError JWSInvalidSignature"
jwtDecodeError JWT.BadCrypto = JwtTokenInvalid "JWSError (CompactDecodeError Invalid number of parts: Expected 3 parts; got 2)"
jwtDecodeError (JWT.BadAlgorithm _) = JwtTokenInvalid "JWSError JWSNoSignatures"
jwtDecodeError e = JwtTokenInvalid $ show e
-- The only errors we can get from JWT.decode function are:
-- BadAlgorithm
-- KeyError
-- BadCrypto
jwtDecodeError (JWT.KeyError _) = JwtDecodeError "No suitable key or wrong key type"
jwtDecodeError (JWT.BadAlgorithm _) = JwtDecodeError "Wrong or unsupported encoding algorithm"
jwtDecodeError JWT.BadCrypto = JwtDecodeError "JWT cryptographic operation failed"
-- Control never reaches here, the decode function only returns the above three
jwtDecodeError _ = JwtDecodeError "JWT couldn't be decoded"
verifyClaims :: JWT.JwtContent -> Either JwtError JSON.Value
verifyClaims (JWT.Jws (_, claims)) = case JSON.decodeStrict claims of
Nothing -> Left $ JwtTokenInvalid "Parsing claims failed"
Nothing -> Left $ JwtClaimsError "Parsing claims failed"
Just (JSON.Object mclaims)
| failedExpClaim mclaims -> Left $ JwtTokenInvalid "JWT expired"
| failedNbfClaim mclaims -> Left $ JwtTokenInvalid "JWTNotYetValid"
| failedIatClaim mclaims -> Left $ JwtTokenInvalid "JWTIssuedAtFuture"
| failedAudClaim mclaims -> Left $ JwtTokenInvalid "JWTNotInAudience"
| 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
-- TODO: We could enable JWE support here (encrypted tokens)
verifyClaims _ = Left $ JwtTokenInvalid "Unsupported token type"
verifyClaims _ = Left $ JwtDecodeError "Unsupported token type"
allowedSkewSeconds = 30 :: Int64
now = floor . nominalDiffTimeToSeconds $ utcTimeToPOSIXSeconds time
@@ -148,7 +158,7 @@ middleware appState app req respond = do
conf <- getConfig appState
time <- getTime appState
let token = fromMaybe "" $ Wai.extractBearerAuth =<< lookup HTTP.hAuthorization (Wai.requestHeaders req)
let token = Wai.extractBearerAuth =<< lookup HTTP.hAuthorization (Wai.requestHeaders req)
parseJwt = runExceptT $ parseToken conf token time >>= parseClaims conf
jwtCacheState = getJwtCacheState appState
@@ -160,7 +170,9 @@ middleware appState app req respond = do
return $ req { Wai.vault = Wai.vault req & Vault.insert authResultKey authResult & Vault.insert jwtDurKey dur }
(True, maxLifetime) -> do
(dur, authResult) <- timeItT $ lookupJwtCache jwtCacheState token maxLifetime parseJwt time
(dur, authResult) <- timeItT $ case token of
Just tkn -> lookupJwtCache jwtCacheState tkn maxLifetime parseJwt time
Nothing -> parseJwt
return $ req { Wai.vault = Wai.vault req & Vault.insert authResultKey authResult & Vault.insert jwtDurKey dur }
(False, 0) -> do
@@ -168,7 +180,9 @@ middleware appState app req respond = do
return $ req { Wai.vault = Wai.vault req & Vault.insert authResultKey authResult }
(False, maxLifetime) -> do
authResult <- lookupJwtCache jwtCacheState token maxLifetime parseJwt time
authResult <- case token of
Just tkn -> lookupJwtCache jwtCacheState tkn maxLifetime parseJwt time
Nothing -> parseJwt
return $ req { Wai.vault = Wai.vault req & Vault.insert authResultKey authResult }
app req' respond
+19 -10
View File
@@ -577,9 +577,10 @@ data Error
| PgErr PgError
data JwtError
= JwtTokenInvalid Text
| JwtTokenMissing
= JwtDecodeError Text
| JwtSecretMissing
| JwtTokenRequired
| JwtClaimsError Text
instance PgrstError Error where
status (ApiRequestError err) = status err
@@ -593,13 +594,15 @@ instance PgrstError Error where
headers _ = mempty
instance PgrstError JwtError where
status JwtTokenInvalid{} = HTTP.unauthorized401
status JwtTokenMissing = HTTP.status500
status JwtTokenRequired = HTTP.unauthorized401
status JwtDecodeError{} = HTTP.unauthorized401
status JwtSecretMissing = HTTP.status500
status JwtTokenRequired = HTTP.unauthorized401
status JwtClaimsError{} = HTTP.unauthorized401
headers (JwtTokenInvalid m) = [invalidTokenHeader m]
headers JwtTokenRequired = [requiredTokenHeader]
headers _ = mempty
headers (JwtDecodeError m) = [invalidTokenHeader m]
headers JwtTokenRequired = [requiredTokenHeader]
headers (JwtClaimsError m) = [invalidTokenHeader m]
headers _ = mempty
instance JSON.ToJSON Error where
toJSON (ApiRequestError err) = JSON.toJSON err
@@ -608,16 +611,20 @@ instance JSON.ToJSON Error where
toJSON NoSchemaCacheError = toJsonPgrstError
ConnectionErrorCode02 "Could not query the database for the schema cache. Retrying." Nothing Nothing
-- Should we provide hints and description or explain the error in docs or both?
instance JSON.ToJSON JwtError where
toJSON JwtTokenMissing = toJsonPgrstError
toJSON JwtSecretMissing = toJsonPgrstError
JWTErrorCode00 "Server lacks JWT secret" Nothing Nothing
toJSON (JwtTokenInvalid message) = toJsonPgrstError
toJSON (JwtDecodeError message) = toJsonPgrstError
JWTErrorCode01 message Nothing Nothing
toJSON JwtTokenRequired = toJsonPgrstError
JWTErrorCode02 "Anonymous access is disabled" Nothing Nothing
toJSON (JwtClaimsError message) = toJsonPgrstError
JWTErrorCode03 message Nothing Nothing
invalidTokenHeader :: Text -> Header
invalidTokenHeader m =
@@ -710,6 +717,7 @@ data ErrorCode
| JWTErrorCode00
| JWTErrorCode01
| JWTErrorCode02
| JWTErrorCode03
-- Internal errors related to the Hasql library
| InternalErrorCode00
@@ -758,5 +766,6 @@ buildErrorCode code = case code of
JWTErrorCode00 -> "PGRST300"
JWTErrorCode01 -> "PGRST301"
JWTErrorCode02 -> "PGRST302"
JWTErrorCode03 -> "PGRST303"
InternalErrorCode00 -> "PGRSTX00"