Taimoor Zaeem
e9a016670f
This reverts commit fe0386e9c4.
As discussed in https://github.com/PostgREST/postgrest/pull/4984#issuecomment-4652725178.
124 lines
4.0 KiB
Haskell
124 lines
4.0 KiB
Haskell
{-# OPTIONS_GHC -Wno-unused-do-bind #-}
|
|
{-# LANGUAGE LambdaCase #-}
|
|
module PostgREST.Config.JSPath
|
|
( JSPath
|
|
, JSPathExp(..)
|
|
, FilterExp(..)
|
|
, dumpJSPath
|
|
, pRoleClaimKey
|
|
, walkJSPath
|
|
) where
|
|
|
|
import qualified Data.Aeson as JSON
|
|
import qualified Data.Aeson.Key as K
|
|
import qualified Data.Aeson.KeyMap as KM
|
|
import qualified Data.Text as T
|
|
import qualified Data.Vector as V
|
|
import qualified Text.ParserCombinators.Parsec as P
|
|
|
|
import Data.Either.Combinators (mapLeft)
|
|
import Text.ParserCombinators.Parsec ((<?>))
|
|
import Text.Read (read)
|
|
|
|
import Protolude
|
|
|
|
|
|
-- | full jspath, e.g. .property[0].attr.detail[?(@ == "role1")]
|
|
type JSPath = [JSPathExp]
|
|
|
|
-- 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]
|
|
| 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
|
|
|
|
-- | 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.Array ar)) [JSPFilter jspFilter] = case jspFilter of
|
|
EqualsCond txt -> findFirstMatch (==) txt ar
|
|
NotEqualsCond txt -> findFirstMatch (/=) txt ar
|
|
StartsWithCond txt -> findFirstMatch T.isPrefixOf txt ar
|
|
EndsWithCond txt -> findFirstMatch T.isSuffixOf txt ar
|
|
ContainsCond txt -> findFirstMatch T.isInfixOf txt ar
|
|
where
|
|
findFirstMatch matchWith pattern = find (\case
|
|
JSON.String txt -> pattern `matchWith` txt
|
|
_ -> False)
|
|
walkJSPath _ _ = 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)
|
|
|
|
pJSPath :: P.Parser JSPath
|
|
pJSPath = P.many1 pJSPathExp <* P.eof
|
|
|
|
pJSPathExp :: P.Parser JSPathExp
|
|
pJSPathExp = pJSPKey <|> pJSPFilter <|> pJSPIdx
|
|
|
|
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 '"')
|