|
1 | | -{-# OPTIONS_GHC -Wno-unused-do-bind #-} |
2 | | -{-# LANGUAGE LambdaCase #-} |
| 1 | +{-| |
| 2 | +Module : PostgREST.Config.JSPath |
| 3 | +Description : Parsing and evaluation logic of JSPath |
| 4 | +-} |
3 | 5 | module PostgREST.Config.JSPath |
4 | | - ( JSPath |
5 | | - , JSPathExp(..) |
6 | | - , FilterExp(..) |
| 6 | + ( JSPath(..) |
| 7 | + , defaultRoleJSPathKey |
7 | 8 | , dumpJSPath |
8 | 9 | , pRoleClaimKey |
9 | | - , walkJSPath |
| 10 | + , evaluateJSPath |
10 | 11 | ) where |
11 | 12 |
|
12 | 13 | import qualified Data.Aeson as JSON |
13 | | -import qualified Data.Aeson.Key as K |
14 | | -import qualified Data.Aeson.KeyMap as KM |
| 14 | +import qualified Data.Aeson.JSONPath as JSP |
| 15 | +import qualified Data.Aeson.JSONPath.Parser as JSP |
| 16 | +import qualified Data.Aeson.JSONPath.Types as JSP |
15 | 17 | import qualified Data.Text as T |
16 | 18 | import qualified Data.Vector as V |
17 | 19 | import qualified Text.ParserCombinators.Parsec as P |
18 | 20 |
|
19 | 21 | import Data.Either.Combinators (mapLeft) |
| 22 | +import Data.Either.Extra (fromRight') |
20 | 23 | import Text.ParserCombinators.Parsec ((<?>)) |
21 | | -import Text.Read (read) |
22 | 24 |
|
23 | 25 | import Protolude |
24 | 26 |
|
25 | 27 |
|
26 | | --- | full jspath, e.g. .property[0].attr.detail[?(@ == "role1")] |
27 | | -type JSPath = [JSPathExp] |
| 28 | +-- | full jspath, e.g. "$.property[0].attr.detail[?(@ == "role1")]" |
| 29 | +newtype JSPath = JSPath JSP.Query |
28 | 30 |
|
29 | | --- NOTE: We only accept one JSPFilter expr (at the end of input) |
30 | | --- | jspath expression |
31 | | -data JSPathExp |
32 | | - = JSPKey Text -- .property or ."property-dash" |
33 | | - | JSPIdx Int -- [0] |
34 | | - | JSPFilter FilterExp -- [?(@ == "match")] |
| 31 | +-- | Default value for "jwt-role-claim-key" config |
| 32 | +defaultRoleJSPathKey :: JSPath |
| 33 | +defaultRoleJSPathKey = fromRight' $ P.parse pJSPath "" "$.role" |
35 | 34 |
|
36 | | -data FilterExp |
37 | | - = EqualsCond Text |
38 | | - | NotEqualsCond Text |
39 | | - | StartsWithCond Text |
40 | | - | EndsWithCond Text |
41 | | - | ContainsCond Text |
42 | | - |
43 | | -dumpJSPath :: JSPathExp -> Text |
44 | | --- TODO: this needs to be quoted properly for special chars |
45 | | -dumpJSPath (JSPKey k) = "." <> show k |
46 | | -dumpJSPath (JSPIdx i) = "[" <> show i <> "]" |
47 | | -dumpJSPath (JSPFilter cond) = "[?(@" <> expr <> ")]" |
48 | | - where |
49 | | - expr = |
50 | | - case cond of |
51 | | - EqualsCond text -> " == " <> show text |
52 | | - NotEqualsCond text -> " != " <> show text |
53 | | - StartsWithCond text -> " ^== " <> show text |
54 | | - EndsWithCond text -> " ==^ " <> show text |
55 | | - ContainsCond text -> " *== " <> show text |
56 | | - |
57 | | --- | Evaluate JSPath on a JSON |
58 | | -walkJSPath :: Maybe JSON.Value -> JSPath -> Maybe JSON.Value |
59 | | -walkJSPath x [] = x |
60 | | -walkJSPath (Just (JSON.Object o)) (JSPKey key:rest) = walkJSPath (KM.lookup (K.fromText key) o) rest |
61 | | -walkJSPath (Just (JSON.Array ar)) (JSPIdx idx:rest) = walkJSPath (ar V.!? idx) rest |
62 | | -walkJSPath (Just (JSON.Array ar)) [JSPFilter jspFilter] = case jspFilter of |
63 | | - EqualsCond txt -> findFirstMatch (==) txt ar |
64 | | - NotEqualsCond txt -> findFirstMatch (/=) txt ar |
65 | | - StartsWithCond txt -> findFirstMatch T.isPrefixOf txt ar |
66 | | - EndsWithCond txt -> findFirstMatch T.isSuffixOf txt ar |
67 | | - ContainsCond txt -> findFirstMatch T.isInfixOf txt ar |
68 | | - where |
69 | | - findFirstMatch matchWith pattern = find (\case |
70 | | - JSON.String txt -> pattern `matchWith` txt |
71 | | - _ -> False) |
72 | | -walkJSPath _ _ = Nothing |
| 35 | +-- | Dump JSPath |
| 36 | +-- e.g. "$.property[0].attr.detail[?(@ == "role1")]" |
| 37 | +dumpJSPath :: JSPath -> Text |
| 38 | +dumpJSPath (JSPath query) = (escapeDollarChar . escapeDoubleQuotes) jsPathDump |
| 39 | + where |
| 40 | + jsPathDump = JSP.dumpQuery query |
| 41 | + escapeDoubleQuotes = T.replace "\"" "\\\"" |
| 42 | + -- When dumping, $ must be escaped |
| 43 | + escapeDollarChar = T.replace "$" "$$" |
| 44 | + |
| 45 | +-- | |
| 46 | +-- Evaluate JSPath on a JSON |
| 47 | +-- The result of JSON Path query is a Vector, we select the first |
| 48 | +-- string element as the role. |
| 49 | +evaluateJSPath :: Maybe JSON.Value -> JSPath -> Maybe JSON.Value |
| 50 | +evaluateJSPath Nothing _ = Nothing |
| 51 | +evaluateJSPath (Just json) (JSPath query) = JSP.queryQQ query json V.!? 0 |
73 | 52 |
|
74 | 53 | -- Used for the config value "role-claim-key" |
75 | 54 | pRoleClaimKey :: Text -> Either Text JSPath |
76 | 55 | pRoleClaimKey selStr = |
77 | 56 | mapLeft show $ P.parse pJSPath ("failed to parse role-claim-key value (" <> toS selStr <> ")") (toS selStr) |
78 | 57 |
|
| 58 | +-- | Parse RFC 9535 JSPath: $.roles[0] |
79 | 59 | pJSPath :: P.Parser JSPath |
80 | | -pJSPath = P.many1 pJSPathExp <* P.eof |
81 | | - |
82 | | -pJSPathExp :: P.Parser JSPathExp |
83 | | -pJSPathExp = pJSPKey <|> pJSPFilter <|> pJSPIdx |
84 | | - |
85 | | -pJSPKey :: P.Parser JSPathExp |
86 | | -pJSPKey = do |
87 | | - P.char '.' |
88 | | - val <- toS <$> P.many1 (P.alphaNum <|> P.oneOf "_$@") <|> pQuotedValue |
89 | | - return (JSPKey val) <?> "pJSPKey: JSPath attribute key" |
90 | | - |
91 | | -pJSPIdx :: P.Parser JSPathExp |
92 | | -pJSPIdx = do |
93 | | - P.char '[' |
94 | | - num <- read <$> P.many1 P.digit |
95 | | - P.char ']' |
96 | | - return (JSPIdx num) <?> "pJSPIdx: JSPath array index" |
97 | | - |
98 | | -pJSPFilter :: P.Parser JSPathExp |
99 | | -pJSPFilter = do |
100 | | - P.try $ P.string "[?(" |
101 | | - condition <- pFilterConditionParser |
102 | | - P.char ')' |
103 | | - P.char ']' |
104 | | - P.eof -- this should be the last jspath expression |
105 | | - return (JSPFilter condition) <?> "pJSPFilter: JSPath filter exp" |
106 | | - |
107 | | -pFilterConditionParser :: P.Parser FilterExp |
108 | | -pFilterConditionParser = do |
109 | | - P.char '@' |
110 | | - P.spaces |
111 | | - filt <- matchOperator |
112 | | - P.spaces |
113 | | - filt <$> pQuotedValue |
114 | | - where |
115 | | - matchOperator = |
116 | | - P.try (P.string "==^" $> EndsWithCond) |
117 | | - <|> P.try (P.string "==" $> EqualsCond) |
118 | | - <|> P.try (P.string "!=" $> NotEqualsCond) |
119 | | - <|> P.try (P.string "^==" $> StartsWithCond) |
120 | | - <|> P.try (P.string "*==" $> ContainsCond) |
121 | | - |
122 | | -pQuotedValue :: P.Parser Text |
123 | | -pQuotedValue = toS <$> (P.char '"' *> P.many (P.noneOf "\"") <* P.char '"') |
| 60 | +pJSPath = JSPath <$> JSP.pQuery <?> "pJSPath: JSPath root query" |
0 commit comments