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

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

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] ""

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: -
 --