Merge pull request #522 from begriffs/full-jwt

Allow SQL functions to generate registered JWT claims

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

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

src/PostgREST/Auth.hs

@@ -18,19 +18,20 @@ module PostgREST.Auth (
   , tokenJWT
   ) where
 
-import           Control.Monad           (join)
+import           Control.Lens
-import           Data.Aeson              (Value (..), Object)
+import           Data.Aeson              (Value (..), parseJSON, toJSON)
-import           Data.Aeson.Types        (emptyObject, emptyArray)
+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 qualified Data.Vector             as V
-import           Data.Map                as M (fromList, toList)
+import qualified Data.HashMap.Strict     as M
+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
@@ -39,12 +40,12 @@ import qualified Data.HashMap.Lazy       as H
   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 :: M.HashMap Text Value -> [BS.ByteString]
-claimsToSQL = map setVar . toList
+claimsToSQL = map setVar . M.toList
   where
     setVar ("role", String val) = setRole val
-    setVar (k, val) = "set local postgrest.claims." <> cs (pgFmtIdent k) <>
+    setVar (k, val) = "set local " <> cs (pgFmtIdent $ "postgrest.claims." <> k)
-                      " = " <> cs (valueToVariable val) <> ";"
+                      <> " = " <> 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
+  case mClaims of
-    Just expires ->
+    Nothing -> Right M.empty
-      if JWT.secondsSinceEpoch expires > time
+    Just claims -> do
-        then customClaims
+      let mExp = claims ^? key "exp" . _Integer
-        else Nothing
+          expired = fromMaybe False $ (<= time) . fromInteger <$> mExp
-    _ -> customClaims
+      if expired
-  where
+        then Left "JWT expired"
-    decoded = JWT.decodeAndVerifySignature secret input
+        else Right (value2map claims)
-    claim :: (JWT.JWTClaimsSet -> a) -> Maybe a
+ where
-    claim prop = prop . JWT.claims <$> decoded
+  mClaims = toJSON . JWT.claims <$> JWT.decodeAndVerifySignature secret input
-    customClaims = claim JWT.unregisteredClaims
+  value2map (Object o) = o
+  value2map _          = M.empty
 
 {-| Receives the name of a role and returns a SET ROLE statement -}
 setRole :: Text -> BS.ByteString
@@ -76,10 +80,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
+tokenJWT secret (Array arr) =
-                               JWT.def { JWT.unregisteredClaims = fromHashMap o }
+  let obj = if V.null arr then emptyObject else V.head arr
-                          where
+      jcs = parseMaybe parseJSON obj :: Maybe JWT.JWTClaimsSet in
-                            Object o = if V.null a then emptyObject else V.head a
+  JWT.encodeSigned JWT.HS256 secret $ fromMaybe JWT.def jcs
-                            fromHashMap :: Object -> JWT.ClaimsMap
+tokenJWT secret _ = tokenJWT secret emptyArray
-                            fromHashMap = M.fromList . H.toList
-tokenJWT secret _          = tokenJWT secret emptyArray

src/PostgREST/Middleware.hs

@@ -3,6 +3,9 @@
 
 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
 import           Data.String.Conversions       (cs)
@@ -17,38 +20,38 @@ 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           Prelude                       hiding (concat, null)
-
-import qualified Data.Map.Lazy           as M
 
 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
+    let tokenStr = case split (== ' ') (cs auth) of
-      ("Bearer" : tokenStr : _) ->
+          ("Bearer" : t : _) -> t
-        case jwtClaims jwtSecret tokenStr time of
+          _                  -> ""
-          Just claims ->
+        eClaims = jwtClaims jwtSecret tokenStr time
-            if M.member "role" claims
+    case eClaims of
-            then do
+      Left e -> clientErr e
-              mapM_ H.sql $ claimsToSQL claims
+      Right claims ->
-              app req
+        if M.null claims && not (null tokenStr)
-            else invalidJWT
+          then clientErr "Invalid JWT"
-          _ -> invalidJWT
+          else do
-      _ -> app req
+            let cmdBatch = mconcat $ claimsToSQL claims
+            unless (BS.null cmdBatch) (H.sql cmdBatch)
+            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 =

test/Feature/AuthSpec.hs

@@ -24,6 +24,22 @@ 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 "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] ""

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,43 @@ 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: 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: -
 --