mirror of
https://github.com/hasura/graphql-engine.git
synced 2024-12-18 13:02:11 +03:00
ced6275ff0
* add additional tests for testing claims_namespace_path in JWT tokens - add tests for at root level and at a nested level * modify the JWT tests * combine the claims_namespace_path tests together in test-server.sh * change the order of the claims_namespace_path tests * change the order of the claims_namespace_path tests
57 lines
1.8 KiB
Haskell
57 lines
1.8 KiB
Haskell
module Data.Parser.JSONPath
|
|
( parseJSONPath
|
|
, JSONPathElement(..)
|
|
, JSONPath
|
|
) where
|
|
|
|
import Data.Bifunctor
|
|
import qualified Data.Text as T
|
|
import Prelude
|
|
|
|
import Control.Applicative
|
|
import Data.Aeson.Internal (JSONPath, JSONPathElement (..))
|
|
import Data.Attoparsec.Text
|
|
|
|
parseJSONPath :: T.Text -> Either String JSONPath
|
|
parseJSONPath "$" = Right []
|
|
parseJSONPath txt = first (const invalidMessage) $
|
|
parseOnly (optional (char '$') *> many1' element <* endOfInput) txt
|
|
where
|
|
invalidMessage = T.unpack txt
|
|
++ ". Accept letters, digits, underscore (_) or hyphen (-) only"
|
|
++ ". Use single quotes enclosed in bracket (['...']) if there is any special character"
|
|
|
|
element :: Parser JSONPathElement
|
|
element = Key <$> (optional (char '.') *> name) -- field or .field
|
|
<|> bracketElement -- [42] or ['field']
|
|
|
|
name :: Parser T.Text
|
|
name = go <?> "property name" where
|
|
go = do
|
|
firstChar <- letter
|
|
<|> char '_'
|
|
<?> "first character of property name must be a letter or underscore"
|
|
otherChars <- many' (letter <|> digit <|> satisfy (inClass "-_"))
|
|
pure $ T.pack (firstChar:otherChars)
|
|
|
|
-- | Parses a JSON property key or index in square bracket format, e.g.
|
|
-- > [42]
|
|
-- > ["hello"]
|
|
-- > ['你好']
|
|
bracketElement :: Parser JSONPathElement
|
|
bracketElement = do
|
|
optional (char '.') *> char '['
|
|
result <- Index <$> decimal
|
|
<|> Key <$> quotedString '"'
|
|
<|> Key <$> quotedString '\''
|
|
char ']'
|
|
pure result
|
|
where
|
|
quotedString delimiter = do
|
|
char delimiter
|
|
result <- T.pack <$> many' (charOrEscape delimiter)
|
|
char delimiter
|
|
pure result
|
|
|
|
charOrEscape delimiter = (char '\\' *> anyChar) <|> notChar delimiter
|