refactor: move jwt error messages to Error.hs module
This commit is contained in:
committed by
Steve Chavez
parent
72f6036432
commit
aebdc716c7
+19
-18
@@ -50,7 +50,8 @@ import PostgREST.Auth.JwtCache (lookupJwtCache)
|
||||
import PostgREST.Auth.Types (AuthResult (..))
|
||||
import PostgREST.Config (AppConfig (..), FilterExp (..),
|
||||
JSPath, JSPathExp (..))
|
||||
import PostgREST.Error (Error (..), JwtError (..))
|
||||
import PostgREST.Error (Error (..), JwtClaimsError (..),
|
||||
JwtDecodeError (..), JwtError (..))
|
||||
|
||||
import Protolude
|
||||
|
||||
@@ -58,7 +59,7 @@ import Protolude
|
||||
-- JSON object of JWT claims.
|
||||
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 _ (Just "") _ = throwE . JwtErr $ JwtDecodeErr EmptyAuthHeader
|
||||
parseToken AppConfig{..} (Just tkn) time = do
|
||||
secret <- liftEither . maybeToRight (JwtErr JwtSecretMissing) $ configJWKS
|
||||
tknWith3Parts <- liftEither $ hasThreeParts tkn
|
||||
@@ -69,33 +70,33 @@ parseToken AppConfig{..} (Just tkn) time = do
|
||||
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)
|
||||
n -> Left $ JwtErr $ JwtDecodeErr $ UnexpectedParts n
|
||||
jwtDecodeError :: JWT.JwtError -> JwtError
|
||||
-- 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"
|
||||
jwtDecodeError (JWT.KeyError _) = JwtDecodeErr KeyError
|
||||
jwtDecodeError (JWT.BadAlgorithm _) = JwtDecodeErr BadAlgorithm
|
||||
jwtDecodeError JWT.BadCrypto = JwtDecodeErr BadCrypto
|
||||
-- Control never reaches here, the decode function only returns the above three
|
||||
jwtDecodeError _ = JwtDecodeError "JWT couldn't be decoded"
|
||||
jwtDecodeError _ = JwtDecodeErr UnreachableDecodeError
|
||||
|
||||
verifyClaims :: JWT.JwtContent -> Either JwtError JSON.Value
|
||||
verifyClaims (JWT.Jws (_, claims)) = case JSON.decodeStrict claims of
|
||||
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" >>
|
||||
verifyClaim mclaims "exp" isValidExpClaim JWTExpired >>
|
||||
verifyClaim mclaims "nbf" isValidNbfClaim JWTNotYetValid >>
|
||||
verifyClaim mclaims "iat" isValidIatClaim JWTIssuedAtFuture >>
|
||||
verifyClaim mclaims "aud" isValidAudClaim JWTNotInAudience >>
|
||||
return jclaims
|
||||
_ -> Left $ JwtClaimsError "Parsing claims failed"
|
||||
_ -> Left $ JwtClaimsErr ParsingClaimsFailed
|
||||
-- TODO: We could enable JWE support here (encrypted tokens)
|
||||
verifyClaims _ = Left $ JwtDecodeError "Unsupported token type"
|
||||
verifyClaims _ = Left $ JwtDecodeErr UnsupportedTokenType
|
||||
|
||||
verifyClaim mclaims claim func err = do
|
||||
isValid <- maybe (Right True) func (KM.lookup claim mclaims)
|
||||
unless isValid $ Left $ JwtClaimsError err
|
||||
unless isValid $ Left $ JwtClaimsErr err
|
||||
|
||||
allowedSkewSeconds = 30 :: Int64
|
||||
now = floor . nominalDiffTimeToSeconds $ utcTimeToPOSIXSeconds time
|
||||
@@ -104,15 +105,15 @@ parseToken AppConfig{..} (Just tkn) time = do
|
||||
|
||||
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"
|
||||
isValidExpClaim _ = Left $ JwtClaimsErr ExpClaimNotNumber
|
||||
|
||||
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"
|
||||
isValidNbfClaim _ = Left $ JwtClaimsErr NbfClaimNotNumber
|
||||
|
||||
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"
|
||||
isValidIatClaim _ = Left $ JwtClaimsErr IatClaimNotNumber
|
||||
|
||||
isValidAudClaim :: JSON.Value -> Either JwtError Bool
|
||||
isValidAudClaim JSON.Null = Right True -- {"aud": null} is valid for all audiences
|
||||
@@ -120,7 +121,7 @@ parseToken AppConfig{..} (Just tkn) time = do
|
||||
isValidAudClaim (JSON.Array arr)
|
||||
| null arr = Right True -- {"aud": []} is valid for all audiences
|
||||
| allStrings arr = Right $ maybe True (\a -> JSON.String a `elem` arr) configJwtAudience
|
||||
isValidAudClaim _ = Left $ JwtClaimsError "The JWT 'aud' claim must be a string or an array of strings"
|
||||
isValidAudClaim _ = Left $ JwtClaimsErr AudClaimNotStringOrArray
|
||||
|
||||
parseClaims :: Monad m =>
|
||||
AppConfig -> JSON.Value -> ExceptT Error m AuthResult
|
||||
|
||||
+54
-14
@@ -14,6 +14,8 @@ module PostgREST.Error
|
||||
, PgError(..)
|
||||
, Error(..)
|
||||
, JwtError (..)
|
||||
, JwtDecodeError(..)
|
||||
, JwtClaimsError(..)
|
||||
, errorPayload
|
||||
, status
|
||||
) where
|
||||
@@ -644,10 +646,32 @@ data Error
|
||||
deriving Show
|
||||
|
||||
data JwtError
|
||||
= JwtDecodeError Text
|
||||
= JwtDecodeErr JwtDecodeError
|
||||
| JwtSecretMissing
|
||||
| JwtTokenRequired
|
||||
| JwtClaimsError Text
|
||||
| JwtClaimsErr JwtClaimsError
|
||||
deriving Show
|
||||
|
||||
data JwtDecodeError
|
||||
= EmptyAuthHeader
|
||||
| UnexpectedParts Int
|
||||
| KeyError
|
||||
| BadAlgorithm
|
||||
| BadCrypto
|
||||
| UnsupportedTokenType
|
||||
| UnreachableDecodeError
|
||||
deriving Show
|
||||
|
||||
data JwtClaimsError
|
||||
= JWTExpired
|
||||
| JWTNotYetValid
|
||||
| JWTIssuedAtFuture
|
||||
| JWTNotInAudience
|
||||
| ParsingClaimsFailed
|
||||
| ExpClaimNotNumber
|
||||
| NbfClaimNotNumber
|
||||
| IatClaimNotNumber
|
||||
| AudClaimNotStringOrArray
|
||||
deriving Show
|
||||
|
||||
instance PgrstError Error where
|
||||
@@ -693,14 +717,14 @@ instance ErrorBody Error where
|
||||
hint (PgErr err) = hint err
|
||||
|
||||
instance PgrstError JwtError where
|
||||
status JwtDecodeError{} = HTTP.unauthorized401
|
||||
status JwtDecodeErr{} = HTTP.unauthorized401
|
||||
status JwtSecretMissing = HTTP.status500
|
||||
status JwtTokenRequired = HTTP.unauthorized401
|
||||
status JwtClaimsError{} = HTTP.unauthorized401
|
||||
status JwtClaimsErr{} = HTTP.unauthorized401
|
||||
|
||||
headers (JwtDecodeError m) = [invalidTokenHeader m]
|
||||
headers e@(JwtDecodeErr _) = [invalidTokenHeader $ message e]
|
||||
headers JwtTokenRequired = [requiredTokenHeader]
|
||||
headers (JwtClaimsError m) = [invalidTokenHeader m]
|
||||
headers e@(JwtClaimsErr _) = [invalidTokenHeader $ message e]
|
||||
headers _ = mempty
|
||||
|
||||
instance JSON.ToJSON JwtError where
|
||||
@@ -708,15 +732,31 @@ instance JSON.ToJSON JwtError where
|
||||
(code err) (message err) (details err) (hint err)
|
||||
|
||||
instance ErrorBody JwtError where
|
||||
code JwtSecretMissing = "PGRST300"
|
||||
code (JwtDecodeError _) = "PGRST301"
|
||||
code JwtTokenRequired = "PGRST302"
|
||||
code (JwtClaimsError _) = "PGRST303"
|
||||
code JwtSecretMissing = "PGRST300"
|
||||
code (JwtDecodeErr _) = "PGRST301"
|
||||
code JwtTokenRequired = "PGRST302"
|
||||
code (JwtClaimsErr _) = "PGRST303"
|
||||
|
||||
message JwtSecretMissing = "Server lacks JWT secret"
|
||||
message (JwtDecodeError msg) = msg
|
||||
message JwtTokenRequired = "Anonymous access is disabled"
|
||||
message (JwtClaimsError msg) = msg
|
||||
message JwtSecretMissing = "Server lacks JWT secret"
|
||||
message (JwtDecodeErr e) = case e of
|
||||
EmptyAuthHeader -> "Empty JWT is sent in Authorization header"
|
||||
UnexpectedParts n -> "Expected 3 parts in JWT; got " <> show n
|
||||
KeyError -> "No suitable key or wrong key type"
|
||||
BadAlgorithm -> "Wrong or unsupported encoding algorithm"
|
||||
BadCrypto -> "JWT cryptographic operation failed"
|
||||
UnsupportedTokenType -> "Unsupported token type"
|
||||
UnreachableDecodeError -> "JWT couldn't be decoded"
|
||||
message JwtTokenRequired = "Anonymous access is disabled"
|
||||
message (JwtClaimsErr e) = case e of
|
||||
JWTExpired -> "JWT expired"
|
||||
JWTNotYetValid -> "JWT not yet valid"
|
||||
JWTIssuedAtFuture -> "JWT issued at future"
|
||||
JWTNotInAudience -> "JWT not in audience"
|
||||
ParsingClaimsFailed -> "Parsing claims failed"
|
||||
ExpClaimNotNumber -> "The JWT 'exp' claim must be a number"
|
||||
NbfClaimNotNumber -> "The JWT 'nbf' claim must be a number"
|
||||
IatClaimNotNumber -> "The JWT 'iat' claim must be a number"
|
||||
AudClaimNotStringOrArray -> "The JWT 'aud' claim must be a string or an array of strings"
|
||||
|
||||
details _ = Nothing
|
||||
|
||||
|
||||
Reference in New Issue
Block a user