jimmy/postgrest
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

refactor: move walkJSPath to Config/JSPath.hs module

Browse Source 
The logic to evaluate `JSPath` belongs to `JSPath.hs` module.
Hence, moving this logic from `Auth/Jwt.hs` to here.

Signed-off-by: Taimoor Zaeem <taimoorzaeem@gmail.com>
This commit is contained in:
Taimoor Zaeem
2026-01-14 22:34:08 +07:00
committed by Steve Chavez
parent 886df84e87
commit c18727ff43
2 changed files with 29 additions and 27 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/PostgREST/Auth/Jwt.hs
+6 -27
View File
@@ -16,14 +16,11 @@ module PostgREST.Auth.Jwt
, parseClaims) where
import qualified Data.Aeson as JSON
import qualified Data.Aeson.Key as K
import qualified Data.Aeson.KeyMap as KM
import qualified Data.ByteString as BS
import qualified Data.ByteString.Internal as BS
import qualified Data.ByteString.Lazy.Char8 as LBS
import qualified Data.Scientific as Sci
import qualified Data.Text as T
import qualified Data.Vector as V
import qualified Jose.Jwk as JWT
import qualified Jose.Jwt as JWT
@@ -33,12 +30,12 @@ import Data.Text ()
import Data.Time.Clock (UTCTime, nominalDiffTimeToSeconds)
import Data.Time.Clock.POSIX (utcTimeToPOSIXSeconds)
import PostgREST.Auth.Types (AuthResult (..))
import PostgREST.Config (AppConfig (..), FilterExp (..), JSPath,
JSPathExp (..), audMatchesCfg)
import PostgREST.Error (Error (..),
JwtClaimsError (AudClaimNotStringOrArray, ExpClaimNotNumber, IatClaimNotNumber, JWTExpired, JWTIssuedAtFuture, JWTNotInAudience, JWTNotYetValid, NbfClaimNotNumber, ParsingClaimsFailed),
JwtDecodeError (..), JwtError (..))
import PostgREST.Auth.Types (AuthResult (..))
import PostgREST.Config (AppConfig (..), audMatchesCfg)
import PostgREST.Config.JSPath (walkJSPath)
import PostgREST.Error (Error (..),
JwtClaimsError (AudClaimNotStringOrArray, ExpClaimNotNumber, IatClaimNotNumber, JWTExpired, JWTIssuedAtFuture, JWTNotInAudience, JWTNotYetValid, NbfClaimNotNumber, ParsingClaimsFailed),
JwtDecodeError (..), JwtError (..))
import Data.Aeson ((.:?))
import Data.Aeson.Types (parseMaybe)
@@ -128,24 +125,6 @@ parseClaims cfg@AppConfig{configJwtRoleClaimKey, configDbAnonRole} time mclaims
, authRole = role
}
where
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 (EqualsCond txt)] = findFirstMatch (==) txt ar
walkJSPath (Just (JSON.Array ar)) [JSPFilter (NotEqualsCond txt)] = findFirstMatch (/=) txt ar
walkJSPath (Just (JSON.Array ar)) [JSPFilter (StartsWithCond txt)] = findFirstMatch T.isPrefixOf txt ar
walkJSPath (Just (JSON.Array ar)) [JSPFilter (EndsWithCond txt)] = findFirstMatch T.isSuffixOf txt ar
walkJSPath (Just (JSON.Array ar)) [JSPFilter (ContainsCond txt)] = findFirstMatch T.isInfixOf txt ar
walkJSPath _ _ = Nothing
findFirstMatch matchWith pattern = foldr checkMatch Nothing
where
checkMatch (JSON.String txt) acc
| pattern `matchWith` txt = Just $ JSON.String txt
| otherwise = acc
checkMatch _ acc = acc
unquoted :: JSON.Value -> BS.ByteString
unquoted (JSON.String t) = encodeUtf8 t
unquoted v = LBS.toStrict $ JSON.encode v
src/PostgREST/Config/JSPath.hs
+23
View File
@@ -1,12 +1,19 @@
{-# 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)
@@ -47,6 +54,22 @@ dumpJSPath (JSPFilter cond) = "[?(@" <> expr <> ")]"
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