diff --git a/postgrest.cabal b/postgrest.cabal index 760500073..77c4ebc1a 100644 --- a/postgrest.cabal +++ b/postgrest.cabal @@ -40,6 +40,8 @@ executable postgrest , http-types , interpolatedstring-perl6 , jwt + , lens >=3.8 && < 5.0 + , lens-aeson >= 1.0.0.0 && < 1.1.0.0 , mtl , optparse-applicative >= 0.11 && < 0.13 , parsec @@ -93,6 +95,8 @@ library , http-types , interpolatedstring-perl6 , jwt + , lens + , lens-aeson , mtl , optparse-applicative , parsec @@ -175,6 +179,8 @@ Test-Suite spec , http-types , interpolatedstring-perl6 , jwt + , lens + , lens-aeson , monad-control , mtl , optparse-applicative diff --git a/src/PostgREST/Auth.hs b/src/PostgREST/Auth.hs index 1a514c5a9..99477dcb4 100644 --- a/src/PostgREST/Auth.hs +++ b/src/PostgREST/Auth.hs @@ -18,12 +18,13 @@ module PostgREST.Auth ( , tokenJWT ) where -import Control.Monad (join) -import Data.Aeson (Value (..), parseJSON) +import Control.Lens +import Data.Aeson (Value (..), parseJSON, toJSON) +import Data.Aeson.Lens import Data.Aeson.Types (parseMaybe, emptyObject, emptyArray) import qualified Data.ByteString as BS -import Data.Vector as V (null, head) -import Data.Map as M (toList) +import qualified Data.Vector as V +import qualified Data.HashMap.Strict as M import Data.Maybe (fromMaybe) import Data.Monoid ((<>)) import Data.String.Conversions (cs) @@ -39,12 +40,12 @@ import qualified Web.JWT as JWT this one is mapped to a SET ROLE statement. In case there is any problem decoding the JWT it returns Nothing. -} -claimsToSQL :: JWT.ClaimsMap -> [BS.ByteString] -claimsToSQL = map setVar . toList +claimsToSQL :: M.HashMap Text Value -> [BS.ByteString] +claimsToSQL = map setVar . M.toList where setVar ("role", String val) = setRole val - setVar (k, val) = "set local postgrest.claims." <> cs (pgFmtIdent k) <> - " = " <> cs (valueToVariable val) <> ";" + setVar (k, val) = "set local " <> cs (pgFmtIdent $ "postgrest.claims." <> k) + <> " = " <> cs (valueToVariable val) <> ";" valueToVariable = pgFmtLit . unquoted {-| @@ -52,19 +53,22 @@ claimsToSQL = map setVar . toList returns a map of JWT claims In case there is any problem decoding the JWT it returns Nothing. -} -jwtClaims :: JWT.Secret -> Text -> NominalDiffTime -> Maybe JWT.ClaimsMap + + +jwtClaims :: JWT.Secret -> Text -> NominalDiffTime -> Either Text (M.HashMap Text Value) jwtClaims secret input time = - case join $ claim JWT.exp of - Just expires -> - if JWT.secondsSinceEpoch expires > time - then customClaims - else Nothing - _ -> customClaims - where - decoded = JWT.decodeAndVerifySignature secret input - claim :: (JWT.JWTClaimsSet -> a) -> Maybe a - claim prop = prop . JWT.claims <$> decoded - customClaims = claim JWT.unregisteredClaims + case mClaims of + Nothing -> Right M.empty + Just claims -> do + let mExp = claims ^? key "exp" . _Integer + expired = fromMaybe False $ (<= time) . fromInteger <$> mExp + if expired + then Left "JWT expired" + else Right (value2map claims) + where + mClaims = toJSON . JWT.claims <$> JWT.decodeAndVerifySignature secret input + value2map (Object o) = o + value2map _ = M.empty {-| Receives the name of a role and returns a SET ROLE statement -} setRole :: Text -> BS.ByteString diff --git a/src/PostgREST/Middleware.hs b/src/PostgREST/Middleware.hs index e68ddbc6f..27edbee33 100644 --- a/src/PostgREST/Middleware.hs +++ b/src/PostgREST/Middleware.hs @@ -3,6 +3,7 @@ module PostgREST.Middleware where +import qualified Data.HashMap.Strict as M import Data.Maybe (fromMaybe) import Data.Text import Data.String.Conversions (cs) @@ -17,38 +18,37 @@ import Network.Wai.Middleware.Cors (cors) import Network.Wai.Middleware.Gzip (def, gzip) import Network.Wai.Middleware.Static (only, staticPolicy) -import PostgREST.ApiRequest (pickContentType) +import PostgREST.ApiRequest (pickContentType) import PostgREST.Auth (setRole, jwtClaims, claimsToSQL) import PostgREST.Config (AppConfig (..), corsPolicy) import PostgREST.Error (errResponse) -import Prelude hiding(concat) - -import qualified Data.Map.Lazy as M +import Prelude hiding (concat, null) runWithClaims :: AppConfig -> NominalDiffTime -> (Request -> H.Transaction Response) -> Request -> H.Transaction Response runWithClaims conf time app req = do H.sql setAnon - case split (== ' ') (cs auth) of - ("Bearer" : tokenStr : _) -> - case jwtClaims jwtSecret tokenStr time of - Just claims -> - if M.member "role" claims - then do - mapM_ H.sql $ claimsToSQL claims - app req - else invalidJWT - _ -> invalidJWT - _ -> app req + let tokenStr = case split (== ' ') (cs auth) of + ("Bearer" : t : _) -> t + _ -> "" + eClaims = jwtClaims jwtSecret tokenStr time + case eClaims of + Left e -> clientErr e + Right claims -> + if M.null claims && not (null tokenStr) + then clientErr "Invalid JWT" + else do + mapM_ H.sql $ claimsToSQL claims + app req where hdrs = requestHeaders req jwtSecret = configJwtSecret conf auth = fromMaybe "" $ lookup hAuthorization hdrs anon = cs $ configAnonRole conf setAnon = setRole anon - invalidJWT = return $ errResponse status400 "Invalid JWT" + clientErr = return . errResponse status400 unsupportedAccept :: Application -> Application unsupportedAccept app req respond = diff --git a/test/Feature/AuthSpec.hs b/test/Feature/AuthSpec.hs index f2acdafe8..55e05efab 100644 --- a/test/Feature/AuthSpec.hs +++ b/test/Feature/AuthSpec.hs @@ -32,6 +32,14 @@ spec = describe "authorization" $ do , matchHeaders = ["Content-Type" <:> "application/json"] } + it "sql functions can read custom and standard claims variables" $ do + let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJzdWIiOiJmdW4iLCJqdGkiOiJmb28iLCJuYmYiOjEzMDA4MTkzODAsImV4cCI6OTk5OTk5OTk5OSwiaHR0cDovL3Bvc3RncmVzdC5jb20vZm9vIjp0cnVlLCJpc3MiOiJqb2UiLCJyb2xlIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIiwiaWF0IjoxMzAwODE5MzgwLCJhdWQiOiJldmVyeW9uZSJ9.AQmCA7CMScvfaDRMqRPeUY6eNf--69gpW-kxaWfq9X0" + request methodPost "/rpc/reveal_big_jwt" [auth] "{}" + `shouldRespondWith` [json| [ + {"sub":"fun", "jti":"foo", "nbf":1300819380, "exp":9999999999, + "http://postgrest.com/foo":true, "iss":"joe", "iat":1300819380, + "aud":"everyone"}] |] + it "allows users with permissions to see their tables" $ do let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJyb2xlIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIiwiaWQiOiJqZG9lIn0.y4vZuu1dDdwAl0-S00MCRWRYMlJ5YAMSir6Es6WtWx0" request methodGet "/authors_only" [auth] "" diff --git a/test/fixtures/schema.sql b/test/fixtures/schema.sql index 1b232bc95..6d847a613 100755 --- a/test/fixtures/schema.sql +++ b/test/fixtures/schema.sql @@ -214,6 +214,29 @@ SELECT 'joe'::text as iss, 'fun'::text as sub, 'everyone'::text as aud, $$; +-- +-- Name: reveal_big_jwt(); Type: FUNCTION; Schema: test; Owner: - +-- + +CREATE FUNCTION reveal_big_jwt() RETURNS TABLE ( + iss text, sub text, aud text, exp bigint, + nbf bigint, iat bigint, jti text, "http://postgrest.com/foo" boolean + ) + LANGUAGE sql SECURITY DEFINER + AS $$ +SELECT current_setting('postgrest.claims.iss') as iss, + current_setting('postgrest.claims.sub') as sub, + current_setting('postgrest.claims.aud') as aud, + current_setting('postgrest.claims.exp')::bigint as exp, + current_setting('postgrest.claims.nbf')::bigint as nbf, + current_setting('postgrest.claims.iat')::bigint as iat, + current_setting('postgrest.claims.jti') as jti, + -- role is not included in the claims list + current_setting('postgrest.claims.http://postgrest.com/foo')::boolean + as "http://postgrest.com/foo"; +$$; + + -- -- Name: problem(); Type: FUNCTION; Schema: test; Owner: - --