break: use RFC 9535 syntax for jwt-role-claim-key config

BREAKING CHANGE

On top of it, slice operator can be used by adding the pipe
symbol at the end like `$.roles[0] | [1:]`.

Signed-off-by: Taimoor Zaeem <taimoorzaeem@gmail.com>

Author: taimoorzaeem

nix/overlays/haskell-packages.nix

@@ -49,6 +49,15 @@ let
       # Before upgrading fuzzyset to 0.3, check: https://github.com/PostgREST/postgrest/issues/3329
       fuzzyset = prev.fuzzyset_0_2_4;
 
+      aeson-jsonpath =
+        prev.callHackageDirect
+          {
+            pkg = "aeson-jsonpath";
+            ver = "0.4.2.0";
+            sha256 = "sha256-K+3brf1zjSSjojtSCXFrip5rrP7AO/S4zndAxAnvEfc=";
+          }
+          { };
+
       http2 =
         prev.callHackageDirect
           {

postgrest.cabal

@@ -103,6 +103,7 @@ library
                     , HTTP                      >= 4000.3.7 && < 4000.5
                     , Ranged-sets               >= 0.3 && < 0.6
                     , aeson                     >= 2.0.3 && < 2.3
+                    , aeson-jsonpath            >= 0.4.2 && < 0.5
                     , auto-update               >= 0.1.4 && < 0.3
                     , base64-bytestring         >= 1 && < 1.3
                     , bytestring                >= 0.10.8 && < 0.13

src/PostgREST/Auth/Jwt.hs

@@ -31,7 +31,7 @@ import Data.Time.Clock.POSIX   (utcTimeToPOSIXSeconds)
 
 import PostgREST.Auth.Types    (AuthResult (..))
 import PostgREST.Config        (AppConfig (..), audMatchesCfg)
-import PostgREST.Config.JSPath (walkJSPath)
+import PostgREST.Config.JSPath (evaluateJSPath)
 import PostgREST.Error         (Error (..), JwtClaimsError (..),
                                 JwtDecodeError (..), JwtError (..))
 
@@ -114,7 +114,7 @@ parseClaims cfg@AppConfig{configJwtRoleClaimKey, configDbAnonRole} time mclaims
   validateClaims time (audMatchesCfg cfg) mclaims
   -- role defaults to anon if not specified in jwt
   role <- liftEither . maybeToRight (JwtErr JwtTokenRequired) $
-    unquoted <$> walkJSPath (Just $ JSON.Object mclaims) configJwtRoleClaimKey <|> configDbAnonRole
+    unquoted <$> evaluateJSPath (Just $ JSON.Object mclaims) configJwtRoleClaimKey <|> configDbAnonRole
   pure AuthResult
            { authClaims = mclaims
            , authRole = role

src/PostgREST/Config.hs

@@ -15,8 +15,7 @@ module PostgREST.Config
   ( AppConfig (..)
   , Environment
   , JSPath
-  , JSPathExp(..)
-  , FilterExp(..)
+  , defaultRoleJSPathKey
   , LogLevel(..)
   , OpenAPIMode(..)
   , Proxy(..)
@@ -63,9 +62,9 @@ import System.Posix.Types      (FileMode)
 
 import PostgREST.Config.Database         (RoleIsolationLvl,
                                           RoleSettings)
-import PostgREST.Config.JSPath           (FilterExp (..), JSPath,
-                                          JSPathExp (..), dumpJSPath,
-                                          pRoleClaimKey)
+import PostgREST.Config.JSPath           (JSPath (..),
+                                          defaultRoleJSPathKey,
+                                          dumpJSPath, pRoleClaimKey)
 import PostgREST.Config.Proxy            (Proxy (..),
                                           isMalformedProxyUri, toURI)
 import PostgREST.SchemaCache.Identifiers (QualifiedIdentifier (..),
@@ -189,7 +188,7 @@ toText conf =
       ,("db-tx-end",                 q . showTxEnd)
       ,("db-uri",                    q . configDbUri)
       ,("jwt-aud",                   q . fromMaybe mempty . configJwtAudience)
-      ,("jwt-role-claim-key",        q . T.intercalate mempty . fmap dumpJSPath . configJwtRoleClaimKey)
+      ,("jwt-role-claim-key",        q . dumpJSPath . configJwtRoleClaimKey)
       ,("jwt-secret",                q . T.decodeUtf8 . showJwtSecret)
       ,("jwt-secret-is-base64",          T.toLower . show . configJwtSecretIsBase64)
       ,("jwt-cache-max-entries",         show . configJwtCacheMaxEntries)
@@ -419,7 +418,7 @@ parser optPath env dbSettings roleSettings roleIsolationLvl =
     parseRoleClaimKey :: C.Key -> C.Key -> C.Parser C.Config JSPath
     parseRoleClaimKey k al =
       optWithAlias (optString k) (optString al) >>= \case
-        Nothing  -> pure [JSPKey "role"]
+        Nothing  -> pure defaultRoleJSPathKey -- $.role
         Just rck -> either (fail . show) pure $ pRoleClaimKey rck
 
     parseCORSAllowedOrigins k =

src/PostgREST/Config/JSPath.hs

@@ -1,17 +1,17 @@
 {-# OPTIONS_GHC -Wno-unused-do-bind #-}
-{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NamedFieldPuns #-}
 module PostgREST.Config.JSPath
-  ( JSPath
-  , JSPathExp(..)
-  , FilterExp(..)
+  ( JSPath(..)
+  , defaultRoleJSPathKey
   , dumpJSPath
   , pRoleClaimKey
-  , walkJSPath
+  , evaluateJSPath
   ) where
 
 import qualified Data.Aeson                    as JSON
-import qualified Data.Aeson.Key                as K
-import qualified Data.Aeson.KeyMap             as KM
+import qualified Data.Aeson.JSONPath           as JSP
+import qualified Data.Aeson.JSONPath.Parser    as JSP
+import qualified Data.Aeson.JSONPath.Types     as JSP
 import qualified Data.Text                     as T
 import qualified Data.Vector                   as V
 import qualified Text.ParserCombinators.Parsec as P
@@ -23,94 +23,68 @@ import Text.Read                     (read)
 import Protolude
 
 
--- | full jspath, e.g. .property[0].attr.detail[?(@ == "role1")]
-type JSPath = [JSPathExp]
+-- | full jspath, e.g. "$.property[0].attr.detail[?(@ == "role1")] | [1:0]"
+data JSPath = JSPath
+  { jsPath      :: JSP.Query
+  , jsPathSlice :: Maybe (Maybe Int, Maybe Int)
+  }
 
--- NOTE: We only accept one JSPFilter expr (at the end of input)
--- | jspath expression
-data JSPathExp
-  = JSPKey Text                      -- .property or ."property-dash"
-  | JSPIdx Int                       -- [0]
-  | JSPSlice (Maybe Int) (Maybe Int) -- [0:5] or [0:] or [:5] or [:]
-  | JSPFilter FilterExp              -- [?(@ == "match")]
+defaultRoleJSPathKey :: JSPath
+defaultRoleJSPathKey = JSPath (JSP.Query JSP.Root [JSP.QuerySegment JSP.Child $ JSP.Dotted "role"]) Nothing
 
-data FilterExp
-  = EqualsCond Text
-  | NotEqualsCond Text
-  | StartsWithCond Text
-  | EndsWithCond Text
-  | ContainsCond Text
-
-dumpJSPath :: JSPathExp -> Text
--- TODO: this needs to be quoted properly for special chars
-dumpJSPath (JSPKey k) = "." <> show k
-dumpJSPath (JSPIdx i) = "[" <> show i <> "]"
-dumpJSPath (JSPSlice s e) = "[" <> maybe "" show s <> ":" <> maybe "" show e <> "]"
-dumpJSPath (JSPFilter cond) = "[?(@" <> expr <> ")]"
-  where
-    expr =
-      case cond of
-        EqualsCond text     -> " == " <> show text
-        NotEqualsCond text  -> " != " <> show text
-        StartsWithCond text -> " ^== " <> show text
-        EndsWithCond text   -> " ==^ " <> show text
-        ContainsCond text   -> " *== " <> show text
+-- | Dump JSPath
+--   e.g. "$$.property[0].attr.detail[?(@ == "role1")] | [1:0]"
+dumpJSPath :: JSPath -> Text
+dumpJSPath JSPath{jsPath, jsPathSlice} =
+  T.replace "\"" "\\\"" (jsPathDump <> jsPathSliceDump jsPathSlice)
+    where
+      jsPathDump = "$" <> JSP.dumpQuery jsPath
+      jsPathSliceDump (Just (s, e)) = T.pack (" | " <> "[" <> maybe "" show s <> ":" <> maybe "" show e <> "]")
+      jsPathSliceDump Nothing = mempty
 
 -- | Evaluate JSPath on a JSON
-walkJSPath :: Maybe JSON.Value -> JSPath -> Maybe JSON.Value
-walkJSPath x                      []                = x
-walkJSPath (Just (JSON.Object o)) (JSPKey key:rest) = walkJSPath (KM.lookup (K.fromText key) o) rest
-walkJSPath (Just (JSON.Array ar)) (JSPIdx idx:rest) = walkJSPath (ar V.!? idx) rest
-walkJSPath (Just (JSON.String str)) (JSPSlice start end:rest) =
-  let
-    len = T.length str
+evaluateJSPath :: Maybe JSON.Value -> JSPath -> Maybe JSON.Value
+evaluateJSPath Nothing _ = Nothing
+evaluateJSPath (Just json) JSPath{jsPath, jsPathSlice} =
+  case jsPathSlice of
+    Nothing      -> role
+    Just indices -> getSlice indices role
+    where
+      jsPathResult = JSP.queryQQ jsPath json
+      role = case jsPathResult V.!? 0 of
+        -- If the result is a string, return it. Otherwise return Nothing
+        Just (JSON.String r) -> Just $ JSON.String r
+        _                    -> Nothing
+
+      getSlice :: (Maybe Int, Maybe Int) -> Maybe JSON.Value -> Maybe JSON.Value
+      getSlice (start, end) (Just (JSON.String str)) = Just $ JSON.String slicedString
+        where
+          len = T.length str
 
-    norm :: Maybe Int -> Maybe Int -- Normalize negative indices to positive
-    norm = fmap (\i -> max 0 $ min len $ if i < 0 then len + i else i)
+          norm :: Maybe Int -> Maybe Int -- Normalize negative indices to positive
+          norm = fmap (\i -> max 0 $ min len $ if i < 0 then len + i else i)
 
-    s = fromMaybe 0 $ norm start -- normalized start index
-    e = fromMaybe len $ norm end -- normalized end index
-    slicedString = if s >= e then T.empty else T.take (e-s) $ T.drop s str
-  in
-    walkJSPath (Just $ JSON.String slicedString) rest
+          s = fromMaybe 0 $ norm start -- normalized start index
+          e = fromMaybe len $ norm end -- normalized end index
+          slicedString = if s >= e then T.empty else T.take (e-s) $ T.drop s str
 
-walkJSPath (Just (JSON.Array ar)) (JSPFilter jspFilter:rest) = case jspFilter of
-    EqualsCond txt     -> walkJSPath (findFirstMatch (==) txt ar) rest
-    NotEqualsCond txt  -> walkJSPath (findFirstMatch (/=) txt ar) rest
-    StartsWithCond txt -> walkJSPath (findFirstMatch T.isPrefixOf txt ar) rest
-    EndsWithCond txt   -> walkJSPath (findFirstMatch T.isSuffixOf txt ar) rest
-    ContainsCond txt   -> walkJSPath (findFirstMatch T.isInfixOf txt ar) rest
-  where
-    findFirstMatch matchWith pattern = find (\case
-      JSON.String txt -> pattern `matchWith` txt
-      _               -> False)
-walkJSPath _                      _                 = Nothing
+      getSlice _ _ = Nothing
 
 -- Used for the config value "role-claim-key"
 pRoleClaimKey :: Text -> Either Text JSPath
 pRoleClaimKey selStr =
   mapLeft show $ P.parse pJSPath ("failed to parse role-claim-key value (" <> toS selStr <> ")") (toS selStr)
 
+-- | Parse RFC 9535 JSPath: $.roles[0]
 pJSPath :: P.Parser JSPath
-pJSPath = P.many1 pJSPathExp <* P.eof
-
-pJSPathExp :: P.Parser JSPathExp
-pJSPathExp = P.try pJSPKey <|> P.try pJSPFilter <|> P.try pJSPIdx <|> pJSPSlice
-
-pJSPKey :: P.Parser JSPathExp
-pJSPKey = do
-  P.char '.'
-  val <- toS <$> P.many1 (P.alphaNum <|> P.oneOf "_$@") <|> pQuotedValue
-  return (JSPKey val) <?> "pJSPKey: JSPath attribute key"
-
-pJSPIdx :: P.Parser JSPathExp
-pJSPIdx = do
-  P.char '['
-  num <- read <$> P.many1 P.digit
-  P.char ']'
-  return (JSPIdx num) <?> "pJSPIdx: JSPath array index"
-
-pJSPSlice :: P.Parser JSPathExp
+pJSPath = do
+  jsPath' <- JSP.pRootQuery
+  jsPathSlice' <- P.optionMaybe (P.try (P.spaces *> P.char '|' *> P.spaces *> pJSPSlice))
+  P.eof
+  return (JSPath jsPath' jsPathSlice') <?> "pJSPath: JSPath root"
+
+-- | Parse slice operator: [1:]
+pJSPSlice :: P.Parser (Maybe Int, Maybe Int)
 pJSPSlice = do
   P.char '['
   startSign <- P.optionMaybe $ P.char '-'
@@ -121,30 +95,4 @@ pJSPSlice = do
   P.char ']'
   let start' = if isJust startSign then ((-1) *) <$> startIndex else startIndex
       end'   = if isJust endSign   then ((-1) *) <$> endIndex   else endIndex
-  return (JSPSlice start' end') <?> "pJSPSlice: JSPath string slice"
-
-pJSPFilter :: P.Parser JSPathExp
-pJSPFilter = do
-  P.try $ P.string "[?("
-  condition <- pFilterConditionParser
-  P.char ')'
-  P.char ']'
-  return (JSPFilter condition) <?> "pJSPFilter: JSPath filter exp"
-
-pFilterConditionParser :: P.Parser FilterExp
-pFilterConditionParser = do
-  P.char '@'
-  P.spaces
-  filt <- matchOperator
-  P.spaces
-  filt <$> pQuotedValue
-    where
-      matchOperator =
-        P.try (P.string "==^" $> EndsWithCond)
-        <|> P.try (P.string "==" $> EqualsCond)
-        <|> P.try (P.string "!=" $> NotEqualsCond)
-        <|> P.try (P.string "^==" $> StartsWithCond)
-        <|> P.try (P.string "*==" $> ContainsCond)
-
-pQuotedValue :: P.Parser Text
-pQuotedValue = toS <$> (P.char '"' *> P.many (P.noneOf "\"") <* P.char '"')
+  return (start', end') <?> "pJSPSlice: JSPath string slice"

stack.yaml

@@ -9,6 +9,7 @@ nix:
     - zlib
 
 extra-deps:
+  - aeson-jsonpath-0.4.2.0
   - configurator-pg-0.2.11
   - fuzzyset-0.2.4
   - hasql-notifications-0.2.4.0

test/io/configs/aliases.config

@@ -2,6 +2,6 @@ db-schema = "provided_through_alias"
 db-pool-timeout = 5
 max-rows = 1000
 pre-request = "check_alias"
-role-claim-key = ".aliased"
+role-claim-key = "$$.aliased"
 root-spec = "open_alias"
 secret-is-base64 = true

test/io/configs/expected/aliases.config

@@ -25,7 +25,7 @@ db-tx-end = "commit"
 db-uri = "postgresql://"
 jwt-aud = ""
 jwt-cache-max-entries = 1000
-jwt-role-claim-key = ".\"aliased\""
+jwt-role-claim-key = "$$.aliased"
 jwt-secret = ""
 jwt-secret-is-base64 = true
 log-level = "error"

test/io/configs/expected/boolean-numeric.config

@@ -25,7 +25,7 @@ db-tx-end = "commit"
 db-uri = "postgresql://"
 jwt-aud = ""
 jwt-cache-max-entries = 1000
-jwt-role-claim-key = ".\"role\""
+jwt-role-claim-key = "$$.role"
 jwt-secret = ""
 jwt-secret-is-base64 = true
 log-level = "error"

test/io/configs/expected/boolean-string.config

@@ -25,7 +25,7 @@ db-tx-end = "commit"
 db-uri = "postgresql://"
 jwt-aud = ""
 jwt-cache-max-entries = 1000
-jwt-role-claim-key = ".\"role\""
+jwt-role-claim-key = "$$.role"
 jwt-secret = ""
 jwt-secret-is-base64 = true
 log-level = "error"