refactor: group jwt errors

src/PostgREST/Auth.hs

@@ -48,7 +48,7 @@ import PostgREST.Auth.JwtCache (lookupJwtCache)
 import PostgREST.Auth.Types    (AuthResult (..))
 import PostgREST.Config        (AppConfig (..), FilterExp (..),
                                 JSPath, JSPathExp (..))
-import PostgREST.Error         (Error (..))
+import PostgREST.Error         (Error (..), JwtError (..))
 
 import Protolude
 
@@ -57,20 +57,20 @@ import Protolude
 parseToken :: AppConfig -> ByteString -> UTCTime -> ExceptT Error IO JSON.Value
 parseToken _ "" _ = return JSON.emptyObject
 parseToken AppConfig{..} token time = do
-  secret <- liftEither . maybeToRight JwtTokenMissing $ configJWKS
+  secret <- liftEither . maybeToRight (JwtErr JwtTokenMissing) $ configJWKS
   eitherContent <- liftIO $ JWT.decode (JWT.keys secret) Nothing token
-  content <- liftEither . mapLeft jwtDecodeError $ eitherContent
-  liftEither $ verifyClaims content
+  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.
-      jwtDecodeError :: JWT.JwtError -> Error
+      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
 
-      verifyClaims :: JWT.JwtContent -> Either Error JSON.Value
+      verifyClaims :: JWT.JwtContent -> Either JwtError JSON.Value
       verifyClaims (JWT.Jws (_, claims)) = case JSON.decodeStrict claims of
         Nothing                    -> Left $ JwtTokenInvalid "Parsing claims failed"
         Just (JSON.Object mclaims)
@@ -110,7 +110,7 @@ parseClaims :: Monad m =>
   AppConfig -> JSON.Value -> ExceptT Error m AuthResult
 parseClaims AppConfig{..} jclaims@(JSON.Object mclaims) = do
   -- role defaults to anon if not specified in jwt
-  role <- liftEither . maybeToRight JwtTokenRequired $
+  role <- liftEither . maybeToRight (JwtErr JwtTokenRequired) $
     unquoted <$> walkJSPath (Just jclaims) configJwtRoleClaimKey <|> configDbAnonRole
   return AuthResult
            { authClaims = mclaims & KM.insert "role" (JSON.toJSON $ decodeUtf8 role)

src/PostgREST/Error.hs

@@ -12,6 +12,7 @@ module PostgREST.Error
   , RangeError(..)
   , PgError(..)
   , Error(..)
+  , JwtError (..)
   , errorPayload
   , status
   ) where
@@ -567,32 +568,47 @@ pgErrorStatus authed (SQL.SessionUsageError (SQL.QueryError _ _ (SQL.ResultError
     _                       -> HTTP.status500
 
 
+-- TODO: separate "SchemaCacheError" from ApiRequestError similar to how we
+-- group them in docs
 data Error
   = ApiRequestError ApiRequestError
-  | JwtTokenInvalid Text
-  | JwtTokenMissing
-  | JwtTokenRequired
+  | JwtErr JwtError
   | NoSchemaCacheError
   | PgErr PgError
 
+data JwtError
+  = JwtTokenInvalid Text
+  | JwtTokenMissing
+  | JwtTokenRequired
+
 instance PgrstError Error where
   status (ApiRequestError err) = status err
-  status JwtTokenInvalid{}     = HTTP.unauthorized401
-  status JwtTokenMissing       = HTTP.status500
-  status JwtTokenRequired      = HTTP.unauthorized401
+  status (JwtErr err)          = status err
   status NoSchemaCacheError    = HTTP.status503
   status (PgErr err)           = status err
 
   headers (ApiRequestError err) = headers err
-  headers (JwtTokenInvalid m)   = [invalidTokenHeader m]
-  headers JwtTokenRequired      = [requiredTokenHeader]
+  headers (JwtErr err)          = headers err
   headers (PgErr err)           = headers err
   headers _                     = mempty
 
+instance PgrstError JwtError where
+  status JwtTokenInvalid{} = HTTP.unauthorized401
+  status JwtTokenMissing   = HTTP.status500
+  status JwtTokenRequired  = HTTP.unauthorized401
+
+  headers (JwtTokenInvalid m) = [invalidTokenHeader m]
+  headers JwtTokenRequired    = [requiredTokenHeader]
+  headers _                   = mempty
+
 instance JSON.ToJSON Error where
-  toJSON NoSchemaCacheError = toJsonPgrstError
+  toJSON (ApiRequestError err) = JSON.toJSON err
+  toJSON (JwtErr err)          = JSON.toJSON err
+  toJSON (PgErr err)           = JSON.toJSON err
+  toJSON NoSchemaCacheError    = toJsonPgrstError
       ConnectionErrorCode02 "Could not query the database for the schema cache. Retrying." Nothing Nothing
 
+instance JSON.ToJSON JwtError where
   toJSON JwtTokenMissing = toJsonPgrstError
       JWTErrorCode00 "Server lacks JWT secret" Nothing Nothing
 
@@ -602,8 +618,6 @@ instance JSON.ToJSON Error where
   toJSON JwtTokenRequired = toJsonPgrstError
       JWTErrorCode02 "Anonymous access is disabled" Nothing Nothing
 
-  toJSON (PgErr err) = JSON.toJSON err
-  toJSON (ApiRequestError err) = JSON.toJSON err
 
 invalidTokenHeader :: Text -> Header
 invalidTokenHeader m =