Semantic WWW-Authenticate headers for problematic JWT

Adapting an OAuth 2.0 convention from RFC 6750 for use with JWT

src/PostgREST/Middleware.hs

@@ -7,16 +7,17 @@ import           Data.Aeson                    (Value (..))
 import qualified Data.HashMap.Strict           as M
 import qualified Hasql.Transaction             as H
 
-import           Network.HTTP.Types.Status     (badRequest400, unauthorized401)
+import           Network.HTTP.Types.Status     (unauthorized401)
-import           Network.Wai                   (Application, Response)
+import           Network.Wai                   (Application, Response,
+                                                responseLBS)
 import           Network.Wai.Middleware.Cors   (cors)
 import           Network.Wai.Middleware.Gzip   (def, gzip)
 import           Network.Wai.Middleware.Static (only, staticPolicy)
 
-import           PostgREST.ApiRequest          (ApiRequest(..))
+import           PostgREST.ApiRequest          (ApiRequest(..), ContentType(..),
+                                                ctToHeader)
 import           PostgREST.Auth                (claimsToSQL, JWTAttempt(..))
 import           PostgREST.Config              (AppConfig (..), corsPolicy)
-import           PostgREST.Error               (errResponse)
 
 import           Protolude                     hiding (concat, null)
 
@@ -25,14 +26,23 @@ runWithClaims :: AppConfig -> JWTAttempt ->
                  ApiRequest -> H.Transaction Response
 runWithClaims conf eClaims app req =
   case eClaims of
-    JWTExpired -> return $ errResponse unauthorized401 "JWT expired"
+    JWTExpired -> return $ unauthed "JWT expired"
-    JWTInvalid -> return $ errResponse badRequest400 "JWT invalid"
+    JWTInvalid -> return $ unauthed "JWT invalid"
     JWTClaims claims -> do
       -- role claim defaults to anon if not specified in jwt
       H.sql . mconcat . claimsToSQL $ M.union claims (M.singleton "role" anon)
       app req
   where
     anon = String . toS $ configAnonRole conf
+    unauthed message = responseLBS unauthorized401
+      [ ctToHeader CTApplicationJSON
+      , ( "WWW-Authenticate"
+        , "Bearer error=\"invalid_token\", " <>
+          "error_description=\"" <> message <> "\""
+        )
+      ]
+      (toS $ "{\"message\":\""<>message<>"\"}")
+
 
 defaultMiddle :: Application -> Application
 defaultMiddle =

test/Feature/AuthSpec.hs

@@ -80,12 +80,26 @@ spec = describe "authorization" $ do
   it "fails with an expired token" $ do
     let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJleHAiOjE0NDY2NzgxNDksInJvbGUiOiJwb3N0Z3Jlc3RfdGVzdF9hdXRob3IiLCJpZCI6Impkb2UifQ.enk_qZ_u6gZsXY4R8bREKB_HNExRpM0lIWSLktk9JJQ"
     request methodGet "/authors_only" [auth] ""
-      `shouldRespondWith` 401
+      `shouldRespondWith` ResponseMatcher {
+          matchBody = Nothing
+        , matchStatus = 401
+        , matchHeaders = [
+            "WWW-Authenticate" <:>
+            "Bearer error=\"invalid_token\", error_description=\"JWT expired\""
+          ]
+        }
 
   it "hides tables from users with invalid JWT" $ do
     let auth = authHeaderJWT "ey9zdGdyZXN0X3Rlc3RfYXV0aG9yIiwiaWQiOiJqZG9lIn0.y4vZuu1dDdwAl0-S00MCRWRYMlJ5YAMSir6Es6WtWx0"
     request methodGet "/authors_only" [auth] ""
-      `shouldRespondWith` 400
+      `shouldRespondWith` ResponseMatcher {
+          matchBody = Nothing
+        , matchStatus = 401
+        , matchHeaders = [
+            "WWW-Authenticate" <:>
+            "Bearer error=\"invalid_token\", error_description=\"JWT invalid\""
+          ]
+        }
 
   it "should fail when jwt contains no claims" $ do
     let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.e30.lu-rG8aSCiw-aOlN0IxpRGz5r7Jwq7K9r3tuMPUpytI"