From 508d722fb24e72f64664015ba3cf501e16b4c133 Mon Sep 17 00:00:00 2001 From: Joe Nelson Date: Thu, 10 Mar 2016 21:49:20 -0800 Subject: [PATCH 1/3] Allow SQL functions to generate registered JWT claims --- CHANGELOG.md | 1 + src/PostgREST/Auth.hs | 20 +++++++++----------- test/Feature/AuthSpec.hs | 8 ++++++++ test/fixtures/schema.sql | 31 +++++++++++++++++++++++++++++++ 4 files changed, 49 insertions(+), 11 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 5bb3cdda8..2af06a29c 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -6,6 +6,7 @@ This project adheres to [Semantic Versioning](http://semver.org/). ## Unreleased ### Fixed +* Allow SQL functions to generate registered JWT claims - @begriffs * Terminate gracefully on SIGTERM (for use in Docker) - @recmo ## [0.3.1.0] - 2016-02-28 diff --git a/src/PostgREST/Auth.hs b/src/PostgREST/Auth.hs index 6a79a88cd..1a514c5a9 100644 --- a/src/PostgREST/Auth.hs +++ b/src/PostgREST/Auth.hs @@ -19,18 +19,18 @@ module PostgREST.Auth ( ) where import Control.Monad (join) -import Data.Aeson (Value (..), Object) -import Data.Aeson.Types (emptyObject, emptyArray) +import Data.Aeson (Value (..), parseJSON) +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 (fromList, toList) +import Data.Map as M (toList) +import Data.Maybe (fromMaybe) import Data.Monoid ((<>)) import Data.String.Conversions (cs) import Data.Text (Text) import Data.Time.Clock (NominalDiffTime) import PostgREST.QueryBuilder (pgFmtLit, pgFmtIdent, unquoted) import qualified Web.JWT as JWT -import qualified Data.HashMap.Lazy as H {-| Receives a map of JWT claims and returns a list @@ -76,10 +76,8 @@ setRole r = "set local role " <> cs (pgFmtLit r) <> ";" and returns a signed JWT. -} tokenJWT :: JWT.Secret -> Value -> Text -tokenJWT secret (Array a) = JWT.encodeSigned JWT.HS256 secret - JWT.def { JWT.unregisteredClaims = fromHashMap o } - where - Object o = if V.null a then emptyObject else V.head a - fromHashMap :: Object -> JWT.ClaimsMap - fromHashMap = M.fromList . H.toList -tokenJWT secret _ = tokenJWT secret emptyArray +tokenJWT secret (Array arr) = + let obj = if V.null arr then emptyObject else V.head arr + jcs = parseMaybe parseJSON obj :: Maybe JWT.JWTClaimsSet in + JWT.encodeSigned JWT.HS256 secret $ fromMaybe JWT.def jcs +tokenJWT secret _ = tokenJWT secret emptyArray diff --git a/test/Feature/AuthSpec.hs b/test/Feature/AuthSpec.hs index 3ae39724f..f2acdafe8 100644 --- a/test/Feature/AuthSpec.hs +++ b/test/Feature/AuthSpec.hs @@ -24,6 +24,14 @@ spec = describe "authorization" $ do , matchHeaders = ["Content-Type" <:> "application/json"] } + it "sql functions can encode custom and standard claims" $ + post "/rpc/jwt_test" "{}" + `shouldRespondWith` ResponseMatcher { + matchBody = Just [json| {"token":"eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJzdWIiOiJmdW4iLCJqdGkiOiJmb28iLCJuYmYiOjEzMDA4MTkzODAsImV4cCI6MTMwMDgxOTM4MCwiaHR0cDovL3Bvc3RncmVzdC5jb20vZm9vIjp0cnVlLCJpc3MiOiJqb2UiLCJyb2xlIjoicG9zdGdyZXN0X3Rlc3QiLCJpYXQiOjEzMDA4MTkzODAsImF1ZCI6ImV2ZXJ5b25lIn0._tQCF79-ZZGMlLktd3csM_bVaiMg7A8YvIb6K2hcu5w"} |] + , matchStatus = 200 + , matchHeaders = ["Content-Type" <:> "application/json"] + } + 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 f4d2eed04..1b232bc95 100755 --- a/test/fixtures/schema.sql +++ b/test/fixtures/schema.sql @@ -50,6 +50,23 @@ CREATE TYPE jwt_claims AS ( id text ); +-- +-- Name: big_jwt_claims; Type: TYPE; Schema: public; Owner: - +-- + +CREATE TYPE big_jwt_claims AS ( + iss text, + sub text, + aud text, + exp integer, + nbf integer, + iat integer, + jti text, + + role text, + "http://postgrest.com/foo" boolean +); + SET search_path = test, pg_catalog; @@ -183,6 +200,20 @@ SELECT rolname::text, id::text FROM postgrest.auth WHERE id = id AND pass = pass $$; +-- +-- Name: jwt_test(); Type: FUNCTION; Schema: test; Owner: - +-- + +CREATE FUNCTION jwt_test() RETURNS public.big_jwt_claims + LANGUAGE sql SECURITY DEFINER + AS $$ +SELECT 'joe'::text as iss, 'fun'::text as sub, 'everyone'::text as aud, + 1300819380 as exp, 1300819380 as nbf, 1300819380 as iat, + 'foo'::text as jti, 'postgrest_test'::text as role, + true as "http://postgrest.com/foo"; +$$; + + -- -- Name: problem(); Type: FUNCTION; Schema: test; Owner: - -- From f67e195f766eed29f5aa30ea62a03f6627d02187 Mon Sep 17 00:00:00 2001 From: Joe Nelson Date: Fri, 11 Mar 2016 19:28:50 -0800 Subject: [PATCH 2/3] Expose all claims via sql postgrest.claims --- postgrest.cabal | 6 +++++ src/PostgREST/Auth.hs | 44 ++++++++++++++++++++----------------- src/PostgREST/Middleware.hs | 32 +++++++++++++-------------- test/Feature/AuthSpec.hs | 8 +++++++ test/fixtures/schema.sql | 23 +++++++++++++++++++ 5 files changed, 77 insertions(+), 36 deletions(-) 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: - -- From a779e9eb8bdbf7ebd7681b41a0ee201f57d459f4 Mon Sep 17 00:00:00 2001 From: Joe Nelson Date: Fri, 11 Mar 2016 23:45:05 -0800 Subject: [PATCH 3/3] Batch the sql commands to set local vars --- src/PostgREST/Middleware.hs | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/src/PostgREST/Middleware.hs b/src/PostgREST/Middleware.hs index 27edbee33..5e3ef2a60 100644 --- a/src/PostgREST/Middleware.hs +++ b/src/PostgREST/Middleware.hs @@ -3,6 +3,8 @@ module PostgREST.Middleware where +import Control.Monad (unless) +import qualified Data.ByteString as BS import qualified Data.HashMap.Strict as M import Data.Maybe (fromMaybe) import Data.Text @@ -40,7 +42,8 @@ runWithClaims conf time app req = do if M.null claims && not (null tokenStr) then clientErr "Invalid JWT" else do - mapM_ H.sql $ claimsToSQL claims + let cmdBatch = mconcat $ claimsToSQL claims + unless (BS.null cmdBatch) (H.sql cmdBatch) app req where hdrs = requestHeaders req