Ensure JWT expires

CHANGELOG.md

@@ -10,6 +10,7 @@ This project adheres to [Semantic Versioning](http://semver.org/).
 - Filter columns, e.g. `?select=col1,col2` - @ruslantalpa
 - Does not execute the count total if header "Prefer: count=none" - @diogob
 - Postgres connection string argument - @calebmer
+- Ensure JWT expires - @calebmer
 
 ### Removed
 - API versioning feature - @calebmer

src/PostgREST/Auth.hs

@@ -25,6 +25,7 @@ import           Data.Map                as M (fromList, toList)
 import           Data.Monoid             ((<>))
 import           Data.String.Conversions (cs)
 import           Data.Text               (Text)
+import           Data.Time.Clock         (NominalDiffTime)
 import           PostgREST.PgQuery       (pgFmtLit, pgFmtIdent, unquoted)
 import qualified Web.JWT                 as JWT
 import qualified Data.HashMap.Lazy       as H
@@ -49,10 +50,19 @@ claimsToSQL = map setVar . toList
   returns a map of JWT claims
   In case there is any problem decoding the JWT it returns Nothing.
 -}
-jwtClaims :: Text -> Text -> Maybe JWT.ClaimsMap
-jwtClaims secret input = JWT.unregisteredClaims . JWT.claims <$> decoded
+jwtClaims :: Text -> Text -> NominalDiffTime -> Maybe JWT.ClaimsMap
+jwtClaims secret input time =
+  case claim JWT.exp of
+    Just (Just expires) ->
+      if JWT.secondsSinceEpoch expires > time
+        then customClaims
+        else Nothing
+    _ -> customClaims
   where
     decoded = JWT.decodeAndVerifySignature (JWT.secret secret) input
+    claim :: (JWT.JWTClaimsSet -> a) -> Maybe a
+    claim prop = prop . JWT.claims <$> decoded
+    customClaims = claim JWT.unregisteredClaims
 
 -- | Receives the name of a role and returns a SET ROLE statement
 setRole :: Text -> Text

src/PostgREST/Main.hs

@@ -24,6 +24,7 @@ import qualified Hasql.Postgres                       as P
 import           Network.Wai
 import           Network.Wai.Handler.Warp             hiding (Connection)
 import           Network.Wai.Middleware.RequestLogger (logStdout)
+import           Data.Time.Clock.POSIX                (getPOSIXTime)
 import           System.IO                            (BufferMode (..),
                                                        hSetBuffering, stderr,
                                                        stdin, stdout)
@@ -72,13 +73,6 @@ main = do
           <> show minimumPgVersion)
     ) supportedOrError
 
-  -- what was this code for?
-  -- roleOrError <- H.session pool $ do
-  --   Identity (role :: Text) <- H.tx Nothing $ H.singleEx
-  --     [H.stmt|SELECT SESSION_USER|]
-  --   return role
-  -- authenticator <- either hasqlError return roleOrError
-
   let txSettings = Just (H.ReadCommitted, Just True)
   metadata <- H.session pool $ H.tx txSettings $ do
     tabs <- allTables
@@ -105,7 +99,8 @@ main = do
   -- print $ findRelation (fakeRels ++ allRels) "test" "pg_source" "clients"
 
   runSettings appSettings $ middle $ \ req respond -> do
+    time <- getPOSIXTime
     body <- strictRequestBody req
     resOrError <- liftIO $ H.session pool $ H.tx txSettings $
-      runWithClaims conf (app dbstructure conf body) req
+      runWithClaims conf time (app dbstructure conf body) req
     either (respond . errResponse) respond resOrError

src/PostgREST/Middleware.hs

@@ -7,6 +7,7 @@ import           Data.Maybe                    (fromMaybe, isNothing)
 import           Data.Monoid
 import           Data.Text
 import           Data.String.Conversions       (cs)
+import           Data.Time.Clock               (NominalDiffTime)
 import qualified Hasql                         as H
 import qualified Hasql.Postgres                as P
 
@@ -32,27 +33,30 @@ import qualified Data.Vector             as V
 import qualified Hasql.Backend           as B
 import qualified Data.Map.Lazy           as M
 
-runWithClaims :: forall s. AppConfig ->
+runWithClaims :: forall s. AppConfig -> NominalDiffTime ->
                  (Request -> H.Tx P.Postgres s Response) ->
                  Request -> H.Tx P.Postgres s Response
-runWithClaims conf app req = do
-    mapM_ H.unitEx $ stmt <$> env
-    app req
- where
-   stmt = (flip $ flip B.Stmt V.empty) True
-   hdrs = requestHeaders req
-   jwtSecret = (cs $ configJwtSecret conf) :: Text
-   auth = fromMaybe "" $ lookup hAuthorization hdrs
-   anon = cs $ configAnonRole conf
-   claims =
-     fromMaybe (M.fromList []) $
-     case split (==' ') (cs auth) of
-       ("Bearer" : jwt : _) -> jwtClaims jwtSecret jwt
-       _ -> Nothing
-   env = if M.member "role" claims
-            then jwtEnv
-            else setRole anon : jwtEnv
-   jwtEnv = claimsToSQL claims
+runWithClaims conf time app req = do
+    _ <- H.unitEx $ stmt 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.unitEx $ stmt <$> claimsToSQL claims
+              app req
+            else invalidJWT
+          _ -> invalidJWT
+      _ -> app req
+  where
+    stmt = (flip $ flip B.Stmt V.empty) True
+    hdrs = requestHeaders req
+    jwtSecret = (cs $ configJwtSecret conf) :: Text
+    auth = fromMaybe "" $ lookup hAuthorization hdrs
+    anon = cs $ configAnonRole conf
+    setAnon = setRole anon
+    invalidJWT = return $ responseLBS status400 [] "Invalid JWT"
 
 redirectInsecure :: Application -> Application
 redirectInsecure app req respond = do

test/Feature/AuthSpec.hs

@@ -31,15 +31,36 @@ spec = beforeAll
     request methodGet "/authors_only" [auth] ""
       `shouldRespondWith` 200
 
+  it "works with tokens which have extra fields" $ do
+    let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJyb2xlIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIiwiaWQiOiJqZG9lIiwia2V5MSI6InZhbHVlMSIsImtleTIiOiJ2YWx1ZTIiLCJrZXkzIjoidmFsdWUzIiwiYSI6MSwiYiI6MiwiYyI6M30.GfydCh-F4wnM379xs0n1zUgalwJIsb6YoBapCo8HlFk"
+    request methodGet "/authors_only" [auth] ""
+      `shouldRespondWith` 200
+
+  -- this test will stop working 9999999999s after the UNIX EPOCH
+  it "succeeds with an unexpired token" $ do
+    let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJleHAiOjk5OTk5OTk5OTksInJvbGUiOiJwb3N0Z3Jlc3RfdGVzdF9hdXRob3IiLCJpZCI6Impkb2UifQ.QaPPLWTuyydMu_q7H4noMT7Lk6P4muet1OpJXF6ofhc"
+    request methodGet "/authors_only" [auth] ""
+      `shouldRespondWith` 200
+
+  it "fails with an expired token" $ do
+    let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJleHAiOjE0NDY2NzgxNDksInJvbGUiOiJwb3N0Z3Jlc3RfdGVzdF9hdXRob3IiLCJpZCI6Impkb2UifQ.enk_qZ_u6gZsXY4R8bREKB_HNExRpM0lIWSLktk9JJQ"
+    request methodGet "/authors_only" [auth] ""
+      `shouldRespondWith` 400
+
   it "hides tables from users with invalid JWT" $ do
     let auth = authHeaderJWT "ey9zdGdyZXN0X3Rlc3RfYXV0aG9yIiwiaWQiOiJqZG9lIn0.y4vZuu1dDdwAl0-S00MCRWRYMlJ5YAMSir6Es6WtWx0"
     request methodGet "/authors_only" [auth] ""
-      `shouldRespondWith` 404
+      `shouldRespondWith` 400
 
-  it "hides tables from users with JWT that contain no claims about role" $ do
+  it "should fail when jwt contains no claims" $ do
     let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.e30.MKYc_lOECtB0LJOiykilAdlHodB-I0_id2qHKq35dmc"
     request methodGet "/authors_only" [auth] ""
-      `shouldRespondWith` 404
+      `shouldRespondWith` 400
+
+  it "hides tables from users with JWT that contain no claims about role" $ do
+    let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJpZCI6Impkb2UifQ.zyohGMnrDy4_8eJTl6I2AUXO3MeCCiwR24aGWRkTE9o"
+    request methodGet "/authors_only" [auth] ""
+      `shouldRespondWith` 400
 
   it "recovers after 400 error with logged in user" $ do
     _ <- post "/authors_only" [json| { "owner": "jdoe", "secret": "test content" } |]

test/SpecHelper.hs

@@ -11,6 +11,7 @@ import Hasql.Postgres as P
 import Data.String.Conversions (cs)
 import Data.Monoid
 import Data.Text hiding (map)
+import Data.Time.Clock.POSIX (getPOSIXTime)
 import qualified Data.Vector as V
 import Control.Monad (void)
 import Control.Applicative
@@ -73,9 +74,10 @@ withApp perform = do
         }
 
   perform $ middle $ \req resp -> do
+    time <- getPOSIXTime
     body <- strictRequestBody req
     result <- liftIO $ H.session pool $ H.tx txSettings
-      $ runWithClaims cfg (app dbstructure cfg body) req
+      $ runWithClaims cfg time (app dbstructure cfg body) req
     either (resp . errResponse) resp result
 
   where middle = defaultMiddle False
@@ -134,7 +136,7 @@ clearProjectsTable :: IO ()
 clearProjectsTable = do
   pool <- testPool
   void . liftIO $ H.session pool $ H.tx Nothing $
-    H.unitEx $ B.Stmt ("delete from test.projects where id > 4") V.empty True
+    H.unitEx $ B.Stmt "delete from test.projects where id > 4" V.empty True
 
 
 createItems :: Int -> IO ()

test/fixtures/schema.sql

@@ -291,6 +291,7 @@ $$ LANGUAGE SQL;
 
 
 CREATE TYPE public.jwt_claims AS (role text, id text);
+
 CREATE FUNCTION test.login(id text, pass text)
 RETURNS public.jwt_claims
 SECURITY DEFINER