Issue http 401 for expired jwt

Fixes #512

src/PostgREST/Auth.hs

@@ -16,6 +16,7 @@ module PostgREST.Auth (
   , containsRole
   , jwtClaims
   , tokenJWT
+  , JWTAttempt(..)
   ) where
 
 import           Protolude
@@ -47,17 +48,24 @@ claimsToSQL claims = roleStmts <> varStmts
   valueToVariable = pgFmtLit . unquoted
 
 {-|
-  Receives the JWT secret (from config) and a JWT and
-  returns a map of JWT claims
-  In case there is any problem decoding the JWT it returns an error Text
+  Possible situations encountered with client JWTs
 -}
-jwtClaims :: JWT.Secret -> Text -> NominalDiffTime -> Either Text (M.HashMap Text Value)
-jwtClaims _ "" _ = Right M.empty
+data JWTAttempt = JWTExpired
+                | JWTInvalid
+                | JWTClaims (M.HashMap Text Value)
+                deriving Eq
+
+{-|
+  Receives the JWT secret (from config) and a JWT and returns a map
+  of JWT claims.
+-}
+jwtClaims :: JWT.Secret -> Text -> NominalDiffTime -> JWTAttempt
+jwtClaims _ "" _ = JWTClaims M.empty
 jwtClaims secret jwt time =
   case isExpired <$> mClaims of
-    Just True -> Left "JWT expired"
-    Nothing -> Left "Invalid JWT"
-    Just False -> Right $ value2map $ fromJust mClaims
+    Just True -> JWTExpired
+    Nothing -> JWTInvalid
+    Just False -> JWTClaims $ value2map $ fromJust mClaims
  where
   isExpired claims =
     let mExp = claims ^? key "exp" . _Integer
@@ -80,6 +88,6 @@ tokenJWT secret _ = tokenJWT secret emptyArray
 {-|
   Whether a response from jwtClaims contains a role claim
 -}
-containsRole :: Either Text (M.HashMap Text Value) -> Bool
-containsRole (Left _) = False
-containsRole (Right claims) = M.member "role" claims
+containsRole :: JWTAttempt -> Bool
+containsRole (JWTClaims claims) = M.member "role" claims
+containsRole _ = False

src/PostgREST/Middleware.hs

@@ -7,33 +7,32 @@ import           Data.Aeson                    (Value (..))
 import qualified Data.HashMap.Strict           as M
 import qualified Hasql.Transaction             as H
 
-import           Network.HTTP.Types.Status     (status400)
+import           Network.HTTP.Types.Status     (badRequest400, unauthorized401)
 import           Network.Wai                   (Application, Response)
 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.Auth                (claimsToSQL)
+import           PostgREST.Auth                (claimsToSQL, JWTAttempt(..))
 import           PostgREST.Config              (AppConfig (..), corsPolicy)
 import           PostgREST.Error               (errResponse)
-import           Data.Text
 
 import           Protolude                     hiding (concat, null)
 
-runWithClaims :: AppConfig -> Either Text (M.HashMap Text Value) ->
+runWithClaims :: AppConfig -> JWTAttempt ->
                  (ApiRequest -> H.Transaction Response) ->
                  ApiRequest -> H.Transaction Response
 runWithClaims conf eClaims app req =
   case eClaims of
-    Left e -> clientErr e
-    Right 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
+    JWTExpired -> return $ errResponse unauthorized401 "JWT expired"
+    JWTInvalid -> return $ errResponse badRequest400 "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
-    clientErr = return . errResponse status400
 
 defaultMiddle :: Application -> Application
 defaultMiddle =

test/Feature/AuthSpec.hs

@@ -80,7 +80,7 @@ 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` 400
+      `shouldRespondWith` 401
 
   it "hides tables from users with invalid JWT" $ do
     let auth = authHeaderJWT "ey9zdGdyZXN0X3Rlc3RfYXV0aG9yIiwiaWQiOiJqZG9lIn0.y4vZuu1dDdwAl0-S00MCRWRYMlJ5YAMSir6Es6WtWx0"
@@ -88,16 +88,16 @@ spec = describe "authorization" $ do
       `shouldRespondWith` 400
 
   it "should fail when jwt contains no claims" $ do
-    let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.e30.MKYc_lOECtB0LJOiykilAdlHodB-I0_id2qHKq35dmc"
+    let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.e30.lu-rG8aSCiw-aOlN0IxpRGz5r7Jwq7K9r3tuMPUpytI"
     request methodGet "/authors_only" [auth] ""
-      `shouldRespondWith` 400
+      `shouldRespondWith` 401
 
   it "hides tables from users with JWT that contain no claims about role" $ do
-    let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJpZCI6Impkb2UifQ.zyohGMnrDy4_8eJTl6I2AUXO3MeCCiwR24aGWRkTE9o"
+    let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJpZCI6Impkb2UifQ.Jneso9X519Vh0z7i9PbXIu7W1HEoq9RRw9BBbyQKFCQ"
     request methodGet "/authors_only" [auth] ""
-      `shouldRespondWith` 400
+      `shouldRespondWith` 401
 
-  it "recovers after 400 error with logged in user" $ do
+  it "recovers after 401 error with logged in user" $ do
     _ <- post "/authors_only" [json| { "owner": "jdoe", "secret": "test content" } |]
     let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJyb2xlIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIiwiaWQiOiJqZG9lIn0.y4vZuu1dDdwAl0-S00MCRWRYMlJ5YAMSir6Es6WtWx0"
     _ <- request methodPost "/rpc/problem" [auth] ""