Merge pull request #590 from begriffs/proper-403

Return proper 401/403 when access denied

src/PostgREST/App.hs

@@ -38,7 +38,7 @@ import           PostgREST.ApiRequest   (ApiRequest(..), ContentType(..)
                                             , Action(..), Target(..)
                                             , PreferRepresentation (..)
                                             , userApiRequest)
-import           PostgREST.Auth            (tokenJWT)
+import           PostgREST.Auth            (tokenJWT, jwtClaims, containsRole)
 import           PostgREST.Config          (AppConfig (..))
 import           PostgREST.DbStructure
 import           PostgREST.Error           (errResponse, pgErrResponse)
@@ -71,10 +71,12 @@ postgrest conf refDbStructure pool =
 
     let schema = cs $ configSchema conf
         apiRequest = userApiRequest schema req body
-        handleReq = runWithClaims conf time (app dbStructure conf) apiRequest
+        eClaims = jwtClaims (configJwtSecret conf) (iJWT apiRequest) time
+        authed = containsRole eClaims
+        handleReq = runWithClaims conf eClaims (app dbStructure conf) apiRequest
         txMode = transactionMode $ iAction apiRequest
 
-    resp <- either pgErrResponse id <$> P.use pool
+    resp <- either (pgErrResponse authed) id <$> P.use pool
       (HT.run handleReq HT.ReadCommitted txMode)
     respond resp
 

src/PostgREST/Auth.hs

@@ -13,6 +13,7 @@ very simple authentication system inside the PostgreSQL database.
 -}
 module PostgREST.Auth (
     claimsToSQL
+  , containsRole
   , jwtClaims
   , tokenJWT
   ) where
@@ -80,3 +81,10 @@ tokenJWT secret (Array arr) =
       jcs = parseMaybe parseJSON obj :: Maybe JWT.JWTClaimsSet in
   JWT.encodeSigned JWT.HS256 secret $ fromMaybe JWT.def jcs
 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

src/PostgREST/Error.hs

@@ -21,9 +21,15 @@ import           Network.Wai               (Response, responseLBS)
 errResponse :: HT.Status -> Text -> Response
 errResponse status message = responseLBS status [(hContentType, "application/json")] (cs $ T.concat ["{\"message\":\"",message,"\"}"])
 
-pgErrResponse :: P.UsageError -> Response
-pgErrResponse e = responseLBS (httpStatus e)
-  [(hContentType, "application/json")] (JSON.encode e)
+pgErrResponse :: Bool -> P.UsageError -> Response
+pgErrResponse authed e =
+  let status = httpStatus authed e
+      jsonType = (hContentType, "application/json")
+      wwwAuth = ("WWW-Authenticate", "Bearer")
+      hdrs = if status == HT.status401
+                then [jsonType, wwwAuth]
+                else [jsonType] in
+  responseLBS status hdrs (JSON.encode e)
 
 instance JSON.ToJSON P.UsageError where
   toJSON (P.ConnectionError e) = JSON.object [
@@ -60,10 +66,9 @@ instance JSON.ToJSON H.Error where
     "message" .= ("Database client error"::String),
     "details" .= (fmap cs d::Maybe T.Text)]
 
-httpStatus :: P.UsageError -> HT.Status
-httpStatus (P.ConnectionError _) =
-  HT.status500
-httpStatus (P.SessionError (H.ResultError (H.ServerError c _ _ _))) =
+httpStatus :: Bool -> P.UsageError -> HT.Status
+httpStatus _ (P.ConnectionError _) = HT.status500
+httpStatus authed (P.SessionError (H.ResultError (H.ServerError c _ _ _))) =
   case cs c of
     '0':'8':_ -> HT.status503 -- pg connection err
     '0':'9':_ -> HT.status500 -- triggered action exception
@@ -88,7 +93,7 @@ httpStatus (P.SessionError (H.ResultError (H.ServerError c _ _ _))) =
     'P':'0':_ -> HT.status500 -- PL/pgSQL Error
     'X':'X':_ -> HT.status500 -- internal Error
     "42P01"   -> HT.status404 -- undefined table
-    "42501"   -> HT.status404 -- insufficient privilege
+    "42501"   -> if authed then HT.status403 else HT.status401 -- insufficient privilege
     _         -> HT.status400
-httpStatus (P.SessionError (H.ResultError _)) = HT.status500
-httpStatus (P.SessionError (H.ClientError _)) = HT.status503
+httpStatus _ (P.SessionError (H.ResultError _)) = HT.status500
+httpStatus _ (P.SessionError (H.ClientError _)) = HT.status503

src/PostgREST/Middleware.hs

@@ -7,7 +7,6 @@ import           Data.Aeson                    (Value (..))
 import qualified Data.HashMap.Strict           as M
 import           Data.String.Conversions       (cs)
 import           Data.Text
-import           Data.Time.Clock               (NominalDiffTime)
 import qualified Hasql.Transaction             as H
 
 import           Network.HTTP.Types.Header     (hAccept)
@@ -19,28 +18,26 @@ import           Network.Wai.Middleware.Gzip   (def, gzip)
 import           Network.Wai.Middleware.Static (only, staticPolicy)
 
 import           PostgREST.ApiRequest          (ApiRequest(..), pickContentType)
-import           PostgREST.Auth                (jwtClaims, claimsToSQL)
+import           PostgREST.Auth                (claimsToSQL)
 import           PostgREST.Config              (AppConfig (..), corsPolicy)
 import           PostgREST.Error               (errResponse)
 
 import           Prelude                       hiding (concat, null)
 
-runWithClaims :: AppConfig -> NominalDiffTime ->
+runWithClaims :: AppConfig -> Either Text (M.HashMap Text Value) ->
                  (ApiRequest -> H.Transaction Response) ->
                  ApiRequest -> H.Transaction Response
-runWithClaims conf time app req = do
-    let eClaims = jwtClaims jwtSecret (iJWT req) time
-    case eClaims of
-      Left e -> clientErr e
-      Right claims ->
-        if M.null claims && not (null $ iJWT req)
-          then clientErr "Invalid JWT"
-          else do
-            -- role claim defaults to anon if not specified in jwt
-            H.sql . mconcat . claimsToSQL $ M.union claims (M.singleton "role" anon)
-            app req
+runWithClaims conf eClaims app req =
+  case eClaims of
+    Left e -> clientErr e
+    Right claims ->
+      if M.null claims && not (null $ iJWT req)
+        then clientErr "Invalid JWT"
+        else 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
-    jwtSecret = configJwtSecret conf
     anon = String . cs $ configAnonRole conf
     clientErr = return . errResponse status400