Use sql to generate jwt, rather than custom haskell

src/PostgREST/App.hs

@@ -7,7 +7,8 @@ module PostgREST.App (
 ) where
 
 import           Control.Applicative
-import qualified Data.ByteString.Char8   as BS
+import           Control.Monad             ((>>))
+import qualified Data.ByteString.Char8     as BS
 import           Data.IORef                (IORef, readIORef)
 import           Data.List                 (delete, lookup)
 import           Data.Maybe                (fromJust)
@@ -45,7 +46,7 @@ import           PostgREST.ApiRequest   (ApiRequest(..), ContentType(..)
                                             , ctToHeader
                                             , userApiRequest
                                             , toHeader)
-import           PostgREST.Auth            (tokenJWT, jwtClaims, containsRole)
+import           PostgREST.Auth            (jwtClaims, containsRole)
 import           PostgREST.Config          (AppConfig (..))
 import           PostgREST.DbStructure
 import           PostgREST.Error           (errResponse, pgErrResponse)
@@ -97,6 +98,8 @@ transactionMode _ = HT.Write
 
 app :: DbStructure -> AppConfig -> ApiRequest -> H.Transaction Response
 app dbStructure conf apiRequest =
+  exposeSecretToSQL (configJwtSecret conf) >>
+
   case (iAction apiRequest, iTarget apiRequest, iPayload apiRequest) of
 
     (ActionRead, TargetIdent qi, Nothing) ->
@@ -213,10 +216,6 @@ app dbStructure conf apiRequest =
      Just (PayloadJSON (UniformObjects payload))) -> do
         let p = V.head payload
             singular = iPreferSingular apiRequest
-            jwtSecret = secret <$> configJwtSecret conf
-            returnType = lookup (qiName qi) $ dbProcs dbStructure
-            returnsJWT = fromMaybe False $
-              isInfixOf "jwt_claims" . pdReturnType <$> returnType
         serves [CTApplicationJSON] (iAccepts apiRequest) $ \_ -> case readSqlParts of
           Left e -> return $ responseLBS status400 [jsonH] $ toS e
           Right (q,cq) -> respondToRange $ do
@@ -224,14 +223,7 @@ app dbStructure conf apiRequest =
             let (tableTotal, queryTotal, body) =
                   fromMaybe (Just 0, 0, emptyArray) row
                 (status, contentRange) = rangeHeader queryTotal tableTotal
-            return $ case (returnsJWT, jwtSecret) of
+            return $ responseLBS status [jsonH, contentRange] (toS . encode $ body)
-              (True, Nothing) ->
-                errResponse status500 "Server lacks JWT secret"
-              (True, Just s) ->
-                responseLBS status [jsonH, contentRange] $
-                  "{\"token\":\"" <> toS (tokenJWT s body) <> "\"}"
-              (False, _) ->
-                responseLBS status [jsonH, contentRange] (toS . encode $ body)
 
     (ActionRead, TargetRoot, Nothing) -> do
       let host = configHost conf

src/PostgREST/Middleware.hs

@@ -19,6 +19,7 @@ import           PostgREST.ApiRequest          (ApiRequest(..), ContentType(..),
 import           PostgREST.Auth                (claimsToSQL, JWTAttempt(..))
 import           PostgREST.Config              (AppConfig (..), corsPolicy)
 import           PostgREST.Error               (errResponse)
+import           PostgREST.QueryBuilder        (pgFmtLit)
 
 import           Protolude                     hiding (concat, null)
 
@@ -45,6 +46,10 @@ runWithClaims conf eClaims app req =
       ]
       (toS $ "{\"message\":\""<>message<>"\"}")
 
+exposeSecretToSQL :: Maybe Text -> H.Transaction ()
+exposeSecretToSQL mS = do
+  for_ mS $ \s ->
+    H.sql $ "set local postgrest.jwt_secret = " <> toS (pgFmtLit s) <> ";"
 
 defaultMiddle :: Application -> Application
 defaultMiddle =

test/Feature/AuthSpec.hs

@@ -12,6 +12,7 @@ import Network.Wai (Application)
 
 spec :: SpecWith Application
 spec = describe "authorization" $ do
+  let single = ("Prefer","plurality=singular")
 
   it "denies access to tables that anonymous does not own" $
     get "/authors_only" `shouldRespondWith` ResponseMatcher {
@@ -38,17 +39,18 @@ spec = describe "authorization" $ do
       }
 
   it "returns jwt functions as jwt tokens" $
-    post "/rpc/login" [json| { "id": "jdoe", "pass": "1234" } |]
+    request methodPost "/rpc/login" [single]
+      [json| { "id": "jdoe", "pass": "1234" } |]
       `shouldRespondWith` ResponseMatcher {
-          matchBody = Just [json| {"token":"eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJyb2xlIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIiwiaWQiOiJqZG9lIn0.y4vZuu1dDdwAl0-S00MCRWRYMlJ5YAMSir6Es6WtWx0"} |]
+          matchBody = Just [json| {"token":"eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJyb2xuYW1lIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIiwiaWQiOiJqZG9lIn0.P2G9EVSVI22MWxXWFuhEYd9BZerLS1WDlqzdqplM15s"} |]
         , matchStatus = 200
         , matchHeaders = ["Content-Type" <:> "application/json; charset=utf-8"]
         }
 
   it "sql functions can encode custom and standard claims" $
-    post "/rpc/jwt_test" "{}"
+    request methodPost  "/rpc/jwt_test" [single] "{}"
       `shouldRespondWith` ResponseMatcher {
-          matchBody = Just [json| {"token":"eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJzdWIiOiJmdW4iLCJqdGkiOiJmb28iLCJuYmYiOjEzMDA4MTkzODAsImV4cCI6MTMwMDgxOTM4MCwiaHR0cDovL3Bvc3RncmVzdC5jb20vZm9vIjp0cnVlLCJpc3MiOiJqb2UiLCJyb2xlIjoicG9zdGdyZXN0X3Rlc3QiLCJpYXQiOjEzMDA4MTkzODAsImF1ZCI6ImV2ZXJ5b25lIn0._tQCF79-ZZGMlLktd3csM_bVaiMg7A8YvIb6K2hcu5w"} |]
+          matchBody = Just [json| {"token":"eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJpc3MiOiJqb2UiLCJzdWIiOiJmdW4iLCJhdWQiOiJldmVyeW9uZSIsImV4cCI6MTMwMDgxOTM4MCwibmJmIjoxMzAwODE5MzgwLCJpYXQiOjEzMDA4MTkzODAsImp0aSI6ImZvbyIsInJvbGUiOiJwb3N0Z3Jlc3RfdGVzdCIsImh0dHA6Ly9wb3N0Z3Jlc3QuY29tL2ZvbyI6dHJ1ZX0.IHF16ZSU6XTbOnUWO8CCpUn2fJwt8P00rlYVyXQjpWc"} |]
         , matchStatus = 200
         , matchHeaders = ["Content-Type" <:> "application/json; charset=utf-8"]
         }

test/Feature/NoJwtSpec.hs

@@ -3,7 +3,6 @@ module Feature.NoJwtSpec where
 -- {{{ Imports
 import Test.Hspec
 import Test.Hspec.Wai
-import Test.Hspec.Wai.JSON
 import Network.HTTP.Types
 
 import SpecHelper
@@ -19,6 +18,6 @@ spec = describe "server started without JWT secret" $ do
     request methodGet "/authors_only" [auth] ""
       `shouldRespondWith` 500
 
-  it "responds with error when attempting to generate JWT token" $
+  it "behaves normally when user does not attempt auth" $ do
-    post "/rpc/login" [json| { "id": "jdoe", "pass": "1234" } |]
+    request methodGet "/items" [] ""
-      `shouldRespondWith` 500
+      `shouldRespondWith` 200

test/SpecHelper.hs

@@ -72,8 +72,10 @@ testProxyCfg =
 setupDb :: IO ()
 setupDb = do
   void $ readProcess "psql" ["-d", "postgres", "-a", "-f", "test/fixtures/database.sql"] []
+  void $ readProcess "psql" ["-d", "postgrest_test", "-a", "-c", "CREATE EXTENSION IF NOT EXISTS pgcrypto;"] []
   loadFixture "roles"
   loadFixture "schema"
+  loadFixture "jwt"
   loadFixture "privileges"
   resetDb
 

test/fixtures/privileges.sql

@@ -2,6 +2,7 @@
 GRANT USAGE ON SCHEMA
       postgrest
     , test
+    , jwt
     , "تست"
 TO postgrest_test_anonymous;
 

test/fixtures/schema.sql

@@ -49,29 +49,11 @@ CREATE EXTENSION IF NOT EXISTS plpgsql WITH SCHEMA pg_catalog;
 SET search_path = public, pg_catalog;
 
 --
--- Name: jwt_claims; Type: TYPE; Schema: public; Owner: -
+-- Name: jwt_token; Type: TYPE; Schema: public; Owner: -
 --
 
-CREATE TYPE jwt_claims AS (
+CREATE TYPE jwt_token AS (
-	role text,
+	token text
-	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
 );
 
 
@@ -208,10 +190,17 @@ $$;
 -- Name: login(text, text); Type: FUNCTION; Schema: test; Owner: -
 --
 
-CREATE FUNCTION login(id text, pass text) RETURNS public.jwt_claims
+CREATE FUNCTION login(id text, pass text) RETURNS public.jwt_token
     LANGUAGE sql SECURITY DEFINER
     AS $$
-SELECT rolname::text, id::text FROM postgrest.auth WHERE id = id AND pass = pass;
+SELECT jwt.sign(
+    row_to_json(r), current_setting('postgrest.jwt_secret')
+  ) as token
+  FROM (
+    SELECT rolname::text, id::text
+      FROM postgrest.auth
+     WHERE id = id AND pass = pass
+  ) r;
 $$;
 
 
@@ -234,13 +223,18 @@ $_$;
 -- Name: jwt_test(); Type: FUNCTION; Schema: test; Owner: -
 --
 
-CREATE FUNCTION jwt_test() RETURNS public.big_jwt_claims
+CREATE FUNCTION jwt_test() RETURNS public.jwt_token
     LANGUAGE sql SECURITY DEFINER
     AS $$
-SELECT 'joe'::text as iss, 'fun'::text as sub, 'everyone'::text as aud,
+SELECT jwt.sign(
+    row_to_json(r), current_setting('postgrest.jwt_secret')
+  ) as token
+  FROM (
+    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";
+       true as "http://postgrest.com/foo"
+  ) r;
 $$;