change: Make jwt-aud config value a regular expression

src/PostgREST/Auth/Jwt.hs

@@ -35,14 +35,15 @@ import Data.Time.Clock.POSIX   (utcTimeToPOSIXSeconds)
 
 import PostgREST.Auth.Types (AuthResult (..))
 import PostgREST.Config     (AppConfig (..), FilterExp (..), JSPath,
-                             JSPathExp (..))
+                             JSPathExp (..), audMatchesCfg)
 import PostgREST.Error      (Error (..),
-                             JwtClaimsError (AudClaimNotStringOrArray, ExpClaimNotNumber, IatClaimNotNumber, JWTExpired, JWTIssuedAtFuture, JWTNotInAudience, JWTNotYetValid, NbfClaimNotNumber, ParsingClaimsFailed),
+                             JwtClaimsError (AudClaimNotStringOrURIOrArray, ExpClaimNotNumber, IatClaimNotNumber, JWTExpired, JWTIssuedAtFuture, JWTNotInAudience, JWTNotYetValid, NbfClaimNotNumber, ParsingClaimsFailed),
                              JwtDecodeError (..), JwtError (..))
 
 import Data.Aeson       ((.:?))
 import Data.Aeson.Types (parseMaybe)
 import Jose.Jwk         (JwkSet)
+import Network.URI      (isURI)
 import Protolude        hiding (first)
 
 parseAndDecodeClaims :: (MonadError Error m, MonadIO m) => JwkSet -> ByteString -> m JSON.Object
@@ -52,22 +53,25 @@ decodeClaims :: MonadError Error m => JWT.JwtContent -> m JSON.Object
 decodeClaims (JWT.Jws (_, claims)) = maybe (throwError (JwtErr $ JwtClaimsErr ParsingClaimsFailed)) pure (JSON.decodeStrict claims)
 decodeClaims _ = throwError $ JwtErr $ JwtDecodeErr UnsupportedTokenType
 
-validateClaims :: MonadError Error m => UTCTime -> Maybe Text -> JSON.Object -> m ()
-validateClaims time getConfigAud claims = liftEither $ maybeToLeft () (fmap JwtErr . getAlt $ JwtClaimsErr <$> checkForErrors time getConfigAud claims)
+validateClaims :: MonadError Error m => UTCTime -> (Text -> Bool) -> JSON.Object -> m ()
+validateClaims time audMatches claims = liftEither $ maybeToLeft () (fmap JwtErr . getAlt $ JwtClaimsErr <$> checkForErrors time audMatches claims)
 
-data ValidAud = VANull | VAString Text | VAArray [Text] deriving Generic
+newtype StringOrURI = StringOrURI { unStringOrURI :: Text }
+instance JSON.FromJSON StringOrURI where
+  parseJSON = fmap StringOrURI . mfilter isValidURI . JSON.parseJSON
+    where
+      isValidURI = (||) <$> not . T.isInfixOf ":" <*> isURI . T.unpack
+
+data ValidAud = VAString StringOrURI | VAArray [StringOrURI] deriving Generic
 instance JSON.FromJSON ValidAud where
-  parseJSON JSON.Null = pure VANull
-  parseJSON o = JSON.genericParseJSON JSON.defaultOptions { JSON.sumEncoding = JSON.UntaggedValue } o
-
-checkForErrors :: (Monad m, forall a. Monoid (m a)) => UTCTime -> Maybe Text -> JSON.Object -> m JwtClaimsError
-checkForErrors time cfgAud = mconcat
-  [
-    claim "exp" ExpClaimNotNumber $ inThePast JWTExpired
-  , claim "nbf" NbfClaimNotNumber $ inTheFuture JWTNotYetValid
-  , claim "iat" IatClaimNotNumber $ inTheFuture JWTIssuedAtFuture
-  , claim "aud" AudClaimNotStringOrArray checkAud
-  ]
+  parseJSON = JSON.genericParseJSON JSON.defaultOptions { JSON.sumEncoding = JSON.UntaggedValue }
+
+checkForErrors :: (Applicative m, Monoid (m JwtClaimsError)) => UTCTime -> (Text -> Bool) -> JSON.Object -> m JwtClaimsError
+checkForErrors time audMatches =
+     claim "exp" ExpClaimNotNumber (inThePast JWTExpired)
+  <> claim "nbf" NbfClaimNotNumber (inTheFuture JWTNotYetValid)
+  <> claim "iat" IatClaimNotNumber (inTheFuture JWTIssuedAtFuture)
+  <> claim "aud" AudClaimNotStringOrURIOrArray (checkValue (not . validAud) JWTNotInAudience)
   where
       allowedSkewSeconds = 30 :: Int64
       sciToInt = fromMaybe 0 . Sci.toBoundedInteger
@@ -79,20 +83,18 @@ checkForErrors time cfgAud = mconcat
 
       checkTime cond = checkValue (cond. sciToInt)
 
-      checkAud = \case
-        (VAString aud)                     -> liftMaybe cfgAud >>= checkValue (aud /=) JWTNotInAudience
-        (VAArray auds) | (not . null) auds -> liftMaybe cfgAud >>= checkValue (not . (`elem` auds)) JWTNotInAudience
-        _                                  -> mempty
-
-      liftMaybe = maybe mempty pure
+      validAud = \case
+        (VAString aud) -> validAudString aud
+        (VAArray auds) -> null auds || any validAudString auds
+      validAudString = audMatches . unStringOrURI
 
       checkValue invalid msg val =
         if invalid val then
           pure msg
         else
           mempty
 
-      claim key parseError checkParsed = maybe (pure parseError) (maybe mempty checkParsed) . parseMaybe (.:? key)
+      claim key parseError checkParsed = maybe (pure parseError) (foldMap checkParsed) . parseMaybe (.:? key)
 
 -- | Receives the JWT secret and audience (from config) and a JWT and returns a
 -- JSON object of JWT claims.
@@ -123,7 +125,7 @@ parseToken secret tkn = do
 
 parseClaims :: (MonadError Error m, MonadIO m) => AppConfig -> UTCTime -> JSON.Object -> m AuthResult
 parseClaims AppConfig{configJwtAudience, configJwtRoleClaimKey, configDbAnonRole} time mclaims = do
-  validateClaims time configJwtAudience mclaims
+  validateClaims time (audMatchesCfg configJwtAudience) mclaims
   -- role defaults to anon if not specified in jwt
   role <- liftEither . maybeToRight (JwtErr JwtTokenRequired) $
     unquoted <$> walkJSPath (Just $ JSON.Object mclaims) configJwtRoleClaimKey <|> configDbAnonRole

src/PostgREST/Config.hs

@@ -19,6 +19,9 @@ module PostgREST.Config
   , LogLevel(..)
   , OpenAPIMode(..)
   , Proxy(..)
+  , CfgAud
+  , audMatchesCfg
+  , parseCfgAud
   , toText
   , isMalformedProxyUri
   , readAppConfig
@@ -28,6 +31,7 @@ module PostgREST.Config
   , addFallbackAppName
   , addTargetSessionAttrs
   , exampleConfigFile
+  , defaultCfgAud
   ) where
 
 import qualified Data.Aeson             as JSON
@@ -49,7 +53,7 @@ import Data.List.NonEmpty      (fromList, toList)
 import Data.Maybe              (fromJust)
 import Data.Scientific         (floatingOrInteger)
 import Jose.Jwk                (Jwk, JwkSet)
-import Network.URI             (escapeURIString, isURI,
+import Network.URI             (escapeURIString,
                                 isUnescapedInURIComponent)
 import Numeric                 (readOct, showOct)
 import System.Environment      (getEnvironment)
@@ -65,8 +69,24 @@ import PostgREST.Config.Proxy            (Proxy (..),
 import PostgREST.SchemaCache.Identifiers (QualifiedIdentifier, dumpQi,
                                           toQi)
 
-import Protolude hiding (Proxy, toList)
+import           Protolude       hiding (Proxy, toList)
+import qualified Text.Regex.TDFA as R
 
+data ParsedValue a = ParsedValue {
+  sourceValue :: Text,
+  parsedValue :: a
+}
+
+newtype CfgAud = CfgAud { unCfgAud :: ParsedValue R.Regex }
+
+parseCfgAud :: Text -> CfgAud
+parseCfgAud = CfgAud . (ParsedValue <*> (R.makeRegex . ("\\`(" <>) . (<> "\\')")))
+
+defaultCfgAud :: CfgAud
+defaultCfgAud = parseCfgAud ""
+
+audMatchesCfg :: CfgAud -> Text -> Bool
+audMatchesCfg = R.matchTest . parsedValue . unCfgAud
 
 data AppConfig = AppConfig
   { configAppSettings              :: [(Text, Text)]
@@ -94,7 +114,7 @@ data AppConfig = AppConfig
   , configDbUri                    :: Text
   , configFilePath                 :: Maybe FilePath
   , configJWKS                     :: Maybe JwkSet
-  , configJwtAudience              :: Maybe Text
+  , configJwtAudience              :: CfgAud
   , configJwtRoleClaimKey          :: JSPath
   , configJwtSecret                :: Maybe BS.ByteString
   , configJwtSecretIsBase64        :: Bool
@@ -166,7 +186,7 @@ toText conf =
       ,("db-pre-config",             q . maybe mempty dumpQi . configDbPreConfig)
       ,("db-tx-end",                 q . showTxEnd)
       ,("db-uri",                    q . configDbUri)
-      ,("jwt-aud",                   q . fromMaybe mempty . configJwtAudience)
+      ,("jwt-aud",                   q . sourceValue . unCfgAud . configJwtAudience)
       ,("jwt-role-claim-key",        q . T.intercalate mempty . fmap dumpJSPath . configJwtRoleClaimKey)
       ,("jwt-secret",                q . T.decodeUtf8 . showJwtSecret)
       ,("jwt-secret-is-base64",          T.toLower . show . configJwtSecretIsBase64)
@@ -274,7 +294,7 @@ parser optPath env dbSettings roleSettings roleIsolationLvl =
     <*> (fromMaybe "postgresql://" <$> optString "db-uri")
     <*> pure optPath
     <*> pure Nothing
-    <*> optStringOrURI "jwt-aud"
+    <*> (maybe defaultCfgAud parseCfgAud <$> optString "jwt-aud")
     <*> parseRoleClaimKey "jwt-role-claim-key" "role-claim-key"
     <*> (fmap encodeUtf8 <$> optString "jwt-secret")
     <*> (fromMaybe False <$> optWithAlias
@@ -392,20 +412,6 @@ parser optPath env dbSettings roleSettings roleIsolationLvl =
     optStringEmptyable :: C.Key -> C.Parser C.Config (Maybe Text)
     optStringEmptyable k = overrideFromDbOrEnvironment C.optional k coerceText
 
-    optStringOrURI :: C.Key -> C.Parser C.Config (Maybe Text)
-    optStringOrURI k = do
-      stringOrURI <- mfilter (/= "") <$> overrideFromDbOrEnvironment C.optional k coerceText
-      -- If the string contains ':' then it should
-      -- be a valid URI according to RFC 3986
-      case stringOrURI of
-        Just s  -> if T.isInfixOf ":" s then validateURI s else return (Just s)
-        Nothing -> return Nothing
-      where
-        validateURI :: Text -> C.Parser C.Config (Maybe Text)
-        validateURI s = if isURI (T.unpack s)
-                          then return $ Just s
-                          else fail "jwt-aud should be a string or a valid URI"
-
     optInt :: (Read i, Integral i) => C.Key -> C.Parser C.Config (Maybe i)
     optInt k = join <$> overrideFromDbOrEnvironment C.optional k coerceInt
 

src/PostgREST/Error.hs

@@ -675,7 +675,7 @@ data JwtClaimsError
   | ExpClaimNotNumber
   | NbfClaimNotNumber
   | IatClaimNotNumber
-  | AudClaimNotStringOrArray
+  | AudClaimNotStringOrURIOrArray
   deriving Show
 
 instance PgrstError Error where
@@ -752,15 +752,15 @@ instance ErrorBody JwtError where
     UnreachableDecodeError -> "JWT couldn't be decoded"
   message JwtTokenRequired = "Anonymous access is disabled"
   message (JwtClaimsErr e) = case e of
-    JWTExpired               -> "JWT expired"
-    JWTNotYetValid           -> "JWT not yet valid"
-    JWTIssuedAtFuture        -> "JWT issued at future"
-    JWTNotInAudience         -> "JWT not in audience"
-    ParsingClaimsFailed      -> "Parsing claims failed"
-    ExpClaimNotNumber        -> "The JWT 'exp' claim must be a number"
-    NbfClaimNotNumber        -> "The JWT 'nbf' claim must be a number"
-    IatClaimNotNumber        -> "The JWT 'iat' claim must be a number"
-    AudClaimNotStringOrArray -> "The JWT 'aud' claim must be a string or an array of strings"
+    JWTExpired                    -> "JWT expired"
+    JWTNotYetValid                -> "JWT not yet valid"
+    JWTIssuedAtFuture             -> "JWT issued at future"
+    JWTNotInAudience              -> "JWT not in audience"
+    ParsingClaimsFailed           -> "Parsing claims failed"
+    ExpClaimNotNumber             -> "The JWT 'exp' claim must be a number"
+    NbfClaimNotNumber             -> "The JWT 'nbf' claim must be a number"
+    IatClaimNotNumber             -> "The JWT 'iat' claim must be a number"
+    AudClaimNotStringOrURIOrArray -> "The JWT 'aud' claim must be a string, URI or an array of mixed strings or URIs"
 
   details (JwtDecodeErr jde) = case jde of
     KeyError dets     -> Just $ JSON.String dets

test/io/fixtures.yaml

@@ -41,11 +41,6 @@ cli:
     use_defaultenv: true
     env:
       PGRST_SERVER_UNIX_SOCKET_MODE: '778'
-  - name: invalid jwt-aud
-    expect: error
-    use_defaultenv: true
-    env:
-      PGRST_JWT_AUD: 'http://%%localhorst.invalid'
   - name: invalid log-level
     expect: error
     use_defaultenv: true

test/io/test_cli.py

@@ -266,17 +266,6 @@ def test_schema_cache_snapshot(baseenv, key, snapshot_yaml):
     assert formatted == snapshot_yaml
 
 
-def test_jwt_aud_config_set_to_invalid_uri(defaultenv):
-    "PostgREST should exit with an error message in output if jwt-aud config is set to an invalid URI"
-    env = {
-        **defaultenv,
-        "PGRST_JWT_AUD": "foo://%%$$^^.com",
-    }
-
-    error = cli(["--dump-config"], env=env, expect_error=True)
-    assert "jwt-aud should be a string or a valid URI" in error
-
-
 def test_jwt_secret_min_length(defaultenv):
     "Should log error and not load the config when the secret is shorter than the minimum admitted length"
 

test/spec/Feature/Auth/AudienceJwtSecretSpec.hs

@@ -40,6 +40,20 @@ spec = describe "test handling of aud claims in JWT when the jwt-aud config is s
           [json|{"code":"PGRST303","details":null,"hint":null,"message":"JWT not in audience"}|]
           { matchStatus = 401 }
 
+    it "fails when the audience claim matches but is not a valid URI" $ do
+      let jwtPayload = [json|
+            {
+              "exp": 9999999999,
+              "role": "postgrest_test_author",
+              "id": "jdoe",
+              "aud": "urn:\\uriaudience"
+            }|]
+          auth = authHeaderJWT $ generateJWT jwtPayload
+      request methodGet "/authors_only" [auth] ""
+        `shouldRespondWith`
+          [json|{"code":"PGRST303","details":null,"hint":null,"message":"The JWT 'aud' claim must be a string, URI or an array of mixed strings or URIs"}|]
+          { matchStatus = 401 }
+
     it "fails when the audience claim is empty" $ do
       let jwtPayload = [json|
             {
@@ -151,7 +165,7 @@ disabledSpec :: SpecWith ((), Application)
 disabledSpec = describe "test handling of aud claims in JWT when the jwt-aud config is not set" $ do
 
   context "when the audience claim is a string" $ do
-    it "ignores the audience claim and suceeds" $ do
+    it "fails when it is not empty" $ do
       let jwtPayload =
             [json|{
               "exp": 9999999999,
@@ -161,7 +175,7 @@ disabledSpec = describe "test handling of aud claims in JWT when the jwt-aud con
             }|]
           auth = authHeaderJWT $ generateJWT jwtPayload
       request methodGet "/authors_only" [auth] ""
-        `shouldRespondWith` 200
+        `shouldRespondWith` 401
 
     it "ignores the audience claim and suceeds when it's empty" $ do
       let jwtPayload =
@@ -176,7 +190,7 @@ disabledSpec = describe "test handling of aud claims in JWT when the jwt-aud con
         `shouldRespondWith` 200
 
   context "when the audience is an array of strings" $ do
-    it "ignores the audience claim and suceeds when it has 1 element" $ do
+    it "fails it has 1 element" $ do
       let jwtPayload = [json|
             {
               "exp": 9999999999,
@@ -186,9 +200,9 @@ disabledSpec = describe "test handling of aud claims in JWT when the jwt-aud con
             }|]
           auth = authHeaderJWT $ generateJWT jwtPayload
       request methodGet "/authors_only" [auth] ""
-        `shouldRespondWith` 200
+        `shouldRespondWith` 401
 
-    it "ignores the audience claim and suceeds when it has more than 1 element" $ do
+    it "fails when it has more than 1 element" $ do
       let jwtPayload = [json|
             {
               "exp": 9999999999,
@@ -198,7 +212,7 @@ disabledSpec = describe "test handling of aud claims in JWT when the jwt-aud con
             }|]
           auth = authHeaderJWT $ generateJWT jwtPayload
       request methodGet "/authors_only" [auth] ""
-        `shouldRespondWith` 200
+        `shouldRespondWith` 401
 
     it "ignores the audience claim and suceeds when it's empty" $ do
       let jwtPayload = [json|

test/spec/Feature/Auth/AuthSpec.hs

@@ -182,7 +182,7 @@ spec = describe "authorization" $ do
         auth = authHeaderJWT $ generateJWT jwtPayload
     request methodGet "/authors_only" [auth] ""
       `shouldRespondWith`
-        [json|{"code":"PGRST303","details":null,"hint":null,"message":"The JWT 'aud' claim must be a string or an array of strings"}|]
+        [json|{"code":"PGRST303","details":null,"hint":null,"message":"The JWT 'aud' claim must be a string, URI or an array of mixed strings or URIs"}|]
         { matchStatus = 401 }
 
   it "fails when the aud claim is an array but it has non-string elements" $ do
@@ -194,7 +194,7 @@ spec = describe "authorization" $ do
         auth = authHeaderJWT $ generateJWT jwtPayload
     request methodGet "/authors_only" [auth] ""
       `shouldRespondWith`
-        [json|{"code":"PGRST303","details":null,"hint":null,"message":"The JWT 'aud' claim must be a string or an array of strings"}|]
+        [json|{"code":"PGRST303","details":null,"hint":null,"message":"The JWT 'aud' claim must be a string, URI or an array of mixed strings or URIs"}|]
         { matchStatus = 401 }
 
   describe "custom pre-request proc acting on id claim" $ do

test/spec/SpecHelper.hs

@@ -34,6 +34,7 @@ import PostgREST.Config                  (AppConfig (..),
                                           JSPathExp (..),
                                           LogLevel (..),
                                           OpenAPIMode (..),
+                                          defaultCfgAud, parseCfgAud,
                                           parseSecret)
 import PostgREST.SchemaCache.Identifiers (QualifiedIdentifier (..))
 import Protolude                         hiding (get, toS)
@@ -135,7 +136,7 @@ baseCfg = let secret = encodeUtf8 "reallyreallyreallyreallyverysafe" in
   , configDbUri                     = "postgresql://"
   , configFilePath                  = Nothing
   , configJWKS                      = rightToMaybe $ parseSecret secret
-  , configJwtAudience               = Nothing
+  , configJwtAudience               = defaultCfgAud
   , configJwtRoleClaimKey           = [JSPKey "role"]
   , configJwtSecret                 = Just secret
   , configJwtSecretIsBase64         = False
@@ -216,7 +217,7 @@ testCfgAudienceJWT :: AppConfig
 testCfgAudienceJWT =
   baseCfg {
     configJwtSecret = Just generateSecret
-  , configJwtAudience = Just "youraudience"
+  , configJwtAudience = parseCfgAud "urn..uriaudience|youraudience"
   , configJWKS = rightToMaybe $ parseSecret generateSecret
   }