feat: support string comparison for jwt-role-claim-key

src/PostgREST/Config/JSPath.hs

@@ -1,6 +1,8 @@
+{-# OPTIONS_GHC -Wno-unused-do-bind #-}
 module PostgREST.Config.JSPath
   ( JSPath
   , JSPathExp(..)
+  , FilterExp(..)
   , dumpJSPath
   , pRoleClaimKey
   ) where
@@ -14,18 +16,37 @@ import Text.Read                     (read)
 import Protolude
 
 
--- | full jspath, e.g. .property[0].attr.detail
+-- | full jspath, e.g. .property[0].attr.detail[?(@ == "role1")]
 type JSPath = [JSPathExp]
 
--- | jspath expression, e.g. .property, .property[0] or ."property-dash"
+-- NOTE: We only accept one JSPFilter expr (at the end of input)
+-- | jspath expression
 data JSPathExp
-  = JSPKey Text
-  | JSPIdx Int
+  = JSPKey Text         -- .property or ."property-dash"
+  | JSPIdx Int          -- [0]
+  | JSPFilter FilterExp -- [?(@ == "match")]
+
+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 (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
+
 
 -- Used for the config value "role-claim-key"
 pRoleClaimKey :: Text -> Either Text JSPath
@@ -33,19 +54,47 @@ pRoleClaimKey selStr =
   mapLeft show $ P.parse pJSPath ("failed to parse role-claim-key value (" <> toS selStr <> ")") (toS selStr)
 
 pJSPath :: P.Parser JSPath
-pJSPath = toJSPath <$> (period *> pPath `P.sepBy` period <* P.eof)
-  where
-    toJSPath :: [(Text, Maybe Int)] -> JSPath
-    toJSPath = concatMap (\(key, idx) -> JSPKey key : maybeToList (JSPIdx <$> idx))
-    period = P.char '.' <?> "period (.)"
-    pPath :: P.Parser (Text, Maybe Int)
-    pPath = (,) <$> pJSPKey <*> P.optionMaybe pJSPIdx
+pJSPath = P.many1 pJSPathExp <* P.eof
 
-pJSPKey :: P.Parser Text
-pJSPKey = toS <$> P.many1 (P.alphaNum <|> P.oneOf "_$@") <|> pQuotedValue <?> "attribute name [a..z0..9_$@])"
+pJSPathExp :: P.Parser JSPathExp
+pJSPathExp = pJSPKey <|> pJSPFilter <|> pJSPIdx
 
-pJSPIdx :: P.Parser Int
-pJSPIdx = P.char '[' *> (read <$> P.many1 P.digit) <* P.char ']' <?> "array index [0..n]"
+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"
+
+pJSPFilter :: P.Parser JSPathExp
+pJSPFilter = do
+  P.try $ P.string "[?("
+  condition <- pFilterConditionParser
+  P.char ')'
+  P.char ']'
+  P.eof -- this should be the last jspath expression
+  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 '"')