refactor: Carve out QueryParams module
This commit is contained in:
monacoremo
committed by
Wolfgang Walther
Wolfgang Walther
parent
51ee072f84
commit
bfbec8fa36
+1
-1
@@ -60,9 +60,9 @@ library
|
||||
PostgREST.RangeQuery
|
||||
PostgREST.Request.ApiRequest
|
||||
PostgREST.Request.DbRequestBuilder
|
||||
PostgREST.Request.Parsers
|
||||
PostgREST.Request.Preferences
|
||||
PostgREST.Request.Types
|
||||
PostgREST.Request.QueryParams
|
||||
PostgREST.Version
|
||||
PostgREST.Workers
|
||||
other-modules: Paths_postgrest
|
||||
|
||||
@@ -79,6 +79,7 @@ import PostgREST.Request.Preferences (PreferCount (..),
|
||||
PreferParameters (..),
|
||||
PreferRepresentation (..),
|
||||
toAppliedHeader)
|
||||
import PostgREST.Request.QueryParams (QueryParams (..))
|
||||
import PostgREST.Request.Types (ReadRequest, fstFieldNames)
|
||||
import PostgREST.Version (prettyVersion)
|
||||
import PostgREST.Workers (connectionWorker, listener)
|
||||
@@ -278,7 +279,7 @@ handleRead headersOnly identifier context@RequestContext{..} = do
|
||||
, ( "Content-Location"
|
||||
, "/"
|
||||
<> toUtf8 (qiName identifier)
|
||||
<> if BS.null iCanonicalQS then mempty else "?" <> iCanonicalQS
|
||||
<> if BS.null (qsCanonical iQueryParams) then mempty else "?" <> qsCanonical iQueryParams
|
||||
)
|
||||
]
|
||||
++ contentTypeHeaders context
|
||||
@@ -326,7 +327,7 @@ handleCreate identifier@QualifiedIdentifier{..} context@RequestContext{..} = do
|
||||
)
|
||||
, Just . RangeQuery.contentRangeH 1 0 $
|
||||
if shouldCount iPreferCount then Just resQueryTotal else Nothing
|
||||
, if null pkCols && isNothing iOnConflict then
|
||||
, if null pkCols && isNothing (qsOnConflict iQueryParams) then
|
||||
Nothing
|
||||
else
|
||||
toAppliedHeader <$> iPreferResolution
|
||||
|
||||
+7
-18
@@ -29,8 +29,10 @@ import Network.Wai (Response, responseLBS)
|
||||
|
||||
import Network.HTTP.Types.Header (Header)
|
||||
|
||||
import PostgREST.ContentType (ContentType (..))
|
||||
import qualified PostgREST.ContentType as ContentType
|
||||
import PostgREST.ContentType (ContentType (..))
|
||||
import qualified PostgREST.ContentType as ContentType
|
||||
import PostgREST.Request.Types (ApiRequestError (..),
|
||||
QPError (..))
|
||||
|
||||
import PostgREST.DbStructure.Proc (ProcDescription (..),
|
||||
ProcParam (..))
|
||||
@@ -52,22 +54,6 @@ class (JSON.ToJSON a) => PgrstError a where
|
||||
errorResponseFor :: a -> Response
|
||||
errorResponseFor err = responseLBS (status err) (headers err) $ errorPayload err
|
||||
|
||||
|
||||
|
||||
data ApiRequestError
|
||||
= ActionInappropriate
|
||||
| InvalidRange
|
||||
| InvalidBody ByteString
|
||||
| ParseRequestError Text Text
|
||||
| NoRelBetween Text Text Text
|
||||
| AmbiguousRelBetween Text Text [Relationship]
|
||||
| AmbiguousRpc [ProcDescription]
|
||||
| NoRpc Text Text [Text] Bool ContentType Bool
|
||||
| InvalidFilters
|
||||
| UnacceptableSchema [Text]
|
||||
| ContentTypeError [ByteString]
|
||||
| UnsupportedVerb -- Unreachable?
|
||||
|
||||
instance PgrstError ApiRequestError where
|
||||
status InvalidRange = HTTP.status416
|
||||
status InvalidFilters = HTTP.status405
|
||||
@@ -75,6 +61,7 @@ instance PgrstError ApiRequestError where
|
||||
status UnsupportedVerb = HTTP.status405
|
||||
status ActionInappropriate = HTTP.status405
|
||||
status (ParseRequestError _ _) = HTTP.status400
|
||||
status (QueryParamError _) = HTTP.status400
|
||||
status NoRelBetween{} = HTTP.status400
|
||||
status AmbiguousRelBetween{} = HTTP.status300
|
||||
status (AmbiguousRpc _) = HTTP.status300
|
||||
@@ -87,6 +74,8 @@ instance PgrstError ApiRequestError where
|
||||
instance JSON.ToJSON ApiRequestError where
|
||||
toJSON (ParseRequestError message details) = JSON.object [
|
||||
"message" .= message, "details" .= details]
|
||||
toJSON (QueryParamError (QPError message details)) = JSON.object [
|
||||
"message" .= message, "details" .= details]
|
||||
toJSON ActionInappropriate = JSON.object [
|
||||
"message" .= ("Bad Request" :: Text)]
|
||||
toJSON (InvalidBody errorMessage) = JSON.object [
|
||||
|
||||
@@ -15,11 +15,9 @@ module PostgREST.Query.SqlFragment
|
||||
, asJsonSingleF
|
||||
, countF
|
||||
, fromQi
|
||||
, ftsOperators
|
||||
, limitOffsetF
|
||||
, locationF
|
||||
, normalizedBody
|
||||
, operators
|
||||
, pgFmtColumn
|
||||
, pgFmtIdent
|
||||
, pgFmtJoinCondition
|
||||
@@ -38,7 +36,6 @@ module PostgREST.Query.SqlFragment
|
||||
|
||||
import qualified Data.ByteString.Char8 as BS
|
||||
import qualified Data.ByteString.Lazy as LBS
|
||||
import qualified Data.HashMap.Strict as M
|
||||
import qualified Data.Text as T
|
||||
import qualified Hasql.DynamicStatements.Snippet as SQL
|
||||
import qualified Hasql.Encoders as HE
|
||||
@@ -51,6 +48,7 @@ import PostgREST.DbStructure.Identifiers (FieldName,
|
||||
import PostgREST.RangeQuery (NonnegRange, allRange,
|
||||
rangeLimit, rangeOffset)
|
||||
import PostgREST.Request.Types (Alias, Field, Filter (..),
|
||||
FtsOperator (..),
|
||||
JoinCondition (..),
|
||||
JsonOperand (..),
|
||||
JsonOperation (..),
|
||||
@@ -61,6 +59,7 @@ import PostgREST.Request.Types (Alias, Field, Filter (..),
|
||||
OrderDirection (..),
|
||||
OrderNulls (..),
|
||||
OrderTerm (..), SelectItem,
|
||||
SimpleOperator (..),
|
||||
TrileanVal (..))
|
||||
|
||||
import Protolude hiding (cast)
|
||||
@@ -75,34 +74,31 @@ noLocationF = "array[]::text[]"
|
||||
sourceCTEName :: SqlFragment
|
||||
sourceCTEName = "pgrst_source"
|
||||
|
||||
operators :: M.HashMap Text SqlFragment
|
||||
operators = M.union (M.fromList [
|
||||
("eq", "="),
|
||||
("gte", ">="),
|
||||
("gt", ">"),
|
||||
("lte", "<="),
|
||||
("lt", "<"),
|
||||
("neq", "<>"),
|
||||
("like", "LIKE"),
|
||||
("ilike", "ILIKE"),
|
||||
("in", "IN"),
|
||||
("is", "IS"),
|
||||
("cs", "@>"),
|
||||
("cd", "<@"),
|
||||
("ov", "&&"),
|
||||
("sl", "<<"),
|
||||
("sr", ">>"),
|
||||
("nxr", "&<"),
|
||||
("nxl", "&>"),
|
||||
("adj", "-|-")]) ftsOperators
|
||||
singleValOperator :: SimpleOperator -> SqlFragment
|
||||
singleValOperator = \case
|
||||
OpEqual -> "="
|
||||
OpGreaterThanEqual -> ">="
|
||||
OpGreaterThan -> ">"
|
||||
OpLessThanEqual -> "<="
|
||||
OpLessThan -> "<"
|
||||
OpNotEqual -> "<>"
|
||||
OpLike -> "like"
|
||||
OpILike -> "ilike"
|
||||
OpContains -> "@>"
|
||||
OpContained -> "<@"
|
||||
OpOverlap -> "&&"
|
||||
OpStrictlyLeft -> "<<"
|
||||
OpStrictlyRight -> ">>"
|
||||
OpNotExtendsRight -> "&<"
|
||||
OpNotExtendsLeft -> "&>"
|
||||
OpAdjacent -> "-|-"
|
||||
|
||||
ftsOperators :: M.HashMap Text SqlFragment
|
||||
ftsOperators = M.fromList [
|
||||
("fts", "@@ to_tsquery"),
|
||||
("plfts", "@@ plainto_tsquery"),
|
||||
("phfts", "@@ phraseto_tsquery"),
|
||||
("wfts", "@@ websearch_to_tsquery")
|
||||
]
|
||||
ftsOperator :: FtsOperator -> SqlFragment
|
||||
ftsOperator = \case
|
||||
FilterFts -> "@@ to_tsquery"
|
||||
FilterFtsPlain -> "@@ plainto_tsquery"
|
||||
FilterFtsPhrase -> "@@ phraseto_tsquery"
|
||||
FilterFtsWebsearch -> "@@ websearch_to_tsquery"
|
||||
|
||||
-- |
|
||||
-- These CTEs convert a json object into a json array, this way we can use json_populate_recordset for all json payloads
|
||||
@@ -227,8 +223,8 @@ pgFmtOrderTerm qi ot =
|
||||
pgFmtFilter :: QualifiedIdentifier -> Filter -> SQL.Snippet
|
||||
pgFmtFilter table (Filter fld (OpExpr hasNot oper)) = notOp <> " " <> case oper of
|
||||
Op op val -> pgFmtFieldOp op <> " " <> case op of
|
||||
"like" -> unknownLiteral (T.map star val)
|
||||
"ilike" -> unknownLiteral (T.map star val)
|
||||
OpLike -> unknownLiteral (T.map star val)
|
||||
OpILike -> unknownLiteral (T.map star val)
|
||||
_ -> unknownLiteral val
|
||||
|
||||
-- IS cannot be prepared. `PREPARE boolplan AS SELECT * FROM projects where id IS $1` will give a syntax error.
|
||||
@@ -249,11 +245,11 @@ pgFmtFilter table (Filter fld (OpExpr hasNot oper)) = notOp <> " " <> case oper
|
||||
_ -> "= ANY (" <> unknownLiteral (pgBuildArrayLiteral vals) <> ") "
|
||||
|
||||
Fts op lang val ->
|
||||
pgFmtFieldOp op <> "(" <> ftsLang lang <> unknownLiteral val <> ") "
|
||||
pgFmtFieldFts op <> "(" <> ftsLang lang <> unknownLiteral val <> ") "
|
||||
where
|
||||
ftsLang = maybe mempty (\l -> unknownLiteral l <> ", ")
|
||||
pgFmtFieldOp op = pgFmtField table fld <> " " <> sqlOperator op
|
||||
sqlOperator o = SQL.sql $ M.lookupDefault "=" o operators
|
||||
pgFmtFieldOp op = pgFmtField table fld <> " " <> SQL.sql (singleValOperator op)
|
||||
pgFmtFieldFts op = pgFmtField table fld <> " " <> SQL.sql (ftsOperator op)
|
||||
notOp = if hasNot then "NOT" else mempty
|
||||
star c = if c == '*' then '%' else c
|
||||
|
||||
|
||||
@@ -31,15 +31,11 @@ import qualified Data.Vector as V
|
||||
|
||||
import Control.Arrow ((***))
|
||||
import Data.Aeson.Types (emptyArray, emptyObject)
|
||||
import Data.List (last, lookup, partition, union)
|
||||
import Data.List (lookup, union)
|
||||
import Data.Maybe (fromJust)
|
||||
import Data.Ranged.Boundaries (Boundary (..))
|
||||
import Data.Ranged.Ranges (Range (..), emptyRange,
|
||||
rangeIntersection)
|
||||
import Network.HTTP.Base (urlEncodeVars)
|
||||
import Data.Ranged.Ranges (emptyRange, rangeIntersection)
|
||||
import Network.HTTP.Types.Header (hAuthorization, hCookie)
|
||||
import Network.HTTP.Types.URI (parseQueryReplacePlus,
|
||||
parseSimpleQuery)
|
||||
import Network.HTTP.Types.URI (parseSimpleQuery)
|
||||
import Network.Wai (Request (..))
|
||||
import Network.Wai.Parse (parseHttpAccept)
|
||||
import Web.Cookie (parseCookies)
|
||||
@@ -53,21 +49,19 @@ import PostgREST.DbStructure.Identifiers (FieldName,
|
||||
Schema)
|
||||
import PostgREST.DbStructure.Proc (ProcDescription (..),
|
||||
ProcParam (..), ProcsMap)
|
||||
import PostgREST.Error (ApiRequestError (..))
|
||||
import PostgREST.Query.SqlFragment (ftsOperators, operators)
|
||||
import PostgREST.RangeQuery (NonnegRange, allRange,
|
||||
rangeGeq, rangeLimit,
|
||||
rangeOffset, rangeRequested,
|
||||
restrictRange)
|
||||
import PostgREST.Request.Parsers (pRequestColumns)
|
||||
rangeRequested)
|
||||
import PostgREST.Request.Preferences (PreferCount (..),
|
||||
PreferParameters (..),
|
||||
PreferRepresentation (..),
|
||||
PreferResolution (..),
|
||||
PreferTransaction (..))
|
||||
import PostgREST.Request.QueryParams (QueryParams (..))
|
||||
import PostgREST.Request.Types (ApiRequestError (..))
|
||||
|
||||
import qualified PostgREST.ContentType as ContentType
|
||||
import qualified PostgREST.Request.Preferences as Preferences
|
||||
import qualified PostgREST.Request.QueryParams as QueryParams
|
||||
|
||||
import Protolude
|
||||
|
||||
@@ -161,13 +155,8 @@ data ApiRequest = ApiRequest {
|
||||
, iPreferCount :: Maybe PreferCount -- ^ Whether the client wants a result count
|
||||
, iPreferResolution :: Maybe PreferResolution -- ^ Whether the client wants to UPSERT or ignore records on PK conflict
|
||||
, iPreferTransaction :: Maybe PreferTransaction -- ^ Whether the clients wants to commit or rollback the transaction
|
||||
, iFilters :: [(Text, Text)] -- ^ Filters on the result ("id", "eq.10")
|
||||
, iLogic :: [(Text, Text)] -- ^ &and and &or parameters used for complex boolean logic
|
||||
, iSelect :: Maybe Text -- ^ &select parameter used to shape the response
|
||||
, iOnConflict :: Maybe Text -- ^ &on_conflict parameter used to upsert on specific unique keys
|
||||
, iQueryParams :: QueryParams.QueryParams
|
||||
, iColumns :: S.Set FieldName -- ^ parsed colums from &columns parameter and payload
|
||||
, iOrder :: [(Text, Text)] -- ^ &order parameters for each level
|
||||
, iCanonicalQS :: ByteString -- ^ Alphabetized (canonical) request query string for response URLs
|
||||
, iJWT :: Text -- ^ JSON Web Token
|
||||
, iHeaders :: [(ByteString, ByteString)] -- ^ HTTP request headers
|
||||
, iCookies :: [(ByteString, ByteString)] -- ^ Request Cookies
|
||||
@@ -180,12 +169,16 @@ data ApiRequest = ApiRequest {
|
||||
|
||||
-- | Examines HTTP request and translates it into user intent.
|
||||
userApiRequest :: AppConfig -> DbStructure -> Request -> RequestBody -> Either ApiRequestError ApiRequest
|
||||
userApiRequest conf@AppConfig{..} dbStructure req reqBody
|
||||
userApiRequest conf dbStructure req reqBody =
|
||||
apiRequest conf dbStructure req reqBody =<< first QueryParamError (QueryParams.parse (rawQueryString req))
|
||||
|
||||
apiRequest :: AppConfig -> DbStructure -> Request -> RequestBody -> QueryParams.QueryParams -> Either ApiRequestError ApiRequest
|
||||
apiRequest conf@AppConfig{..} dbStructure req reqBody queryparams@QueryParams{..}
|
||||
| isJust profile && fromJust profile `notElem` configDbSchemas = Left $ UnacceptableSchema $ toList configDbSchemas
|
||||
| isTargetingProc && method `notElem` ["HEAD", "GET", "POST"] = Left ActionInappropriate
|
||||
| topLevelRange == emptyRange = Left InvalidRange
|
||||
| shouldParsePayload && isLeft payload = either (Left . InvalidBody) witness payload
|
||||
| isLeft parsedColumns = either Left witness parsedColumns
|
||||
| not expectParams && not (L.null qsParams) = Left $ ParseRequestError "Unexpected param or filter missing operator" ("Failed to parse " <> show qsParams)
|
||||
| otherwise = do
|
||||
acceptContentType <- findAcceptContentType conf action path accepts
|
||||
checkedTarget <- target
|
||||
@@ -200,16 +193,8 @@ userApiRequest conf@AppConfig{..} dbStructure req reqBody
|
||||
, iPreferCount = preferCount
|
||||
, iPreferResolution = preferResolution
|
||||
, iPreferTransaction = preferTransaction
|
||||
, iFilters = filters
|
||||
, iLogic = [(toS k, toS $ fromJust v) | (k,v) <- qParams, isJust v, endingIn ["and", "or"] k ]
|
||||
, iSelect = toS <$> join (lookup "select" qParams)
|
||||
, iOnConflict = toS <$> join (lookup "on_conflict" qParams)
|
||||
, iQueryParams = queryparams
|
||||
, iColumns = payloadColumns
|
||||
, iOrder = [(toS k, toS $ fromJust v) | (k,v) <- qParams, isJust v, endingIn ["order"] k ]
|
||||
, iCanonicalQS = BS.pack $ urlEncodeVars
|
||||
. L.sortOn fst
|
||||
. map (join (***) BS.unpack . second (fromMaybe mempty))
|
||||
$ qString
|
||||
, iJWT = tokenStr
|
||||
, iHeaders = [ (CI.foldedCase k, v) | (k,v) <- hdrs, k /= hCookie]
|
||||
, iCookies = maybe [] parseCookies $ lookupHeader "Cookie"
|
||||
@@ -221,24 +206,9 @@ userApiRequest conf@AppConfig{..} dbStructure req reqBody
|
||||
}
|
||||
where
|
||||
accepts = maybe [CTAny] (map ContentType.decodeContentType . parseHttpAccept) $ lookupHeader "accept"
|
||||
-- queryString with '+' converted to ' '(space)
|
||||
qString = parseQueryReplacePlus True $ rawQueryString req
|
||||
-- rpcQParams = Rpc query params e.g. /rpc/name?param1=val1, similar to filter but with no operator(eq, lt..)
|
||||
(filters, rpcQParams) =
|
||||
case action of
|
||||
ActionInvoke InvGet -> partitionFlts
|
||||
ActionInvoke InvHead -> partitionFlts
|
||||
_ -> (flts, [])
|
||||
partitionFlts = partition (liftM2 (||) (isEmbedPath . fst) (hasOperator . snd)) flts
|
||||
flts =
|
||||
[ (toS k, toS $ fromJust v) |
|
||||
(k,v) <- qParams, isJust v,
|
||||
k `notElem` ["select", "columns"],
|
||||
not (endingIn ["order", "limit", "offset", "and", "or"] k) ]
|
||||
hasOperator val = any (`T.isPrefixOf` val) $
|
||||
((<> ".") <$> "not":M.keys operators) ++
|
||||
((<> "(") <$> M.keys ftsOperators)
|
||||
isEmbedPath = T.isInfixOf "."
|
||||
|
||||
expectParams = isTargetingProc && method /= "POST"
|
||||
|
||||
isTargetingProc = case path of
|
||||
PathInfo{pHasRpc, pIsRootSpec} -> pHasRpc || pIsRootSpec
|
||||
_ -> False
|
||||
@@ -246,16 +216,19 @@ userApiRequest conf@AppConfig{..} dbStructure req reqBody
|
||||
PathInfo{pIsDefaultSpec=True} -> True
|
||||
_ -> False
|
||||
contentType = maybe CTApplicationJSON ContentType.decodeContentType $ lookupHeader "content-type"
|
||||
columns
|
||||
| action `elem` [ActionCreate, ActionUpdate, ActionInvoke InvPost] = toS <$> join (lookup "columns" qParams)
|
||||
| otherwise = Nothing
|
||||
parsedColumns = pRequestColumns columns
|
||||
|
||||
columns =
|
||||
if action `elem` [ActionCreate, ActionUpdate, ActionInvoke InvPost] then
|
||||
qsColumns
|
||||
else
|
||||
Nothing
|
||||
|
||||
payloadColumns =
|
||||
case (contentType, action) of
|
||||
(_, ActionInvoke InvGet) -> S.fromList $ fst <$> rpcQParams
|
||||
(_, ActionInvoke InvHead) -> S.fromList $ fst <$> rpcQParams
|
||||
(_, ActionInvoke InvGet) -> S.fromList $ fst <$> qsParams
|
||||
(_, ActionInvoke InvHead) -> S.fromList $ fst <$> qsParams
|
||||
(CTUrlEncoded, _) -> S.fromList $ map (T.decodeUtf8 . fst) $ parseSimpleQuery $ LBS.toStrict reqBody
|
||||
_ -> case (relevantPayload, fromRight Nothing parsedColumns) of
|
||||
_ -> case (relevantPayload, columns) of
|
||||
(Just ProcessedJSON{payKeys}, _) -> payKeys
|
||||
(Just RawJSON{}, Just cls) -> cls
|
||||
_ -> S.empty
|
||||
@@ -333,8 +306,8 @@ userApiRequest conf@AppConfig{..} dbStructure req reqBody
|
||||
relevantPayload = case (contentType, action) of
|
||||
-- Though ActionInvoke GET/HEAD doesn't really have a payload, we use the payload variable as a way
|
||||
-- to store the query string arguments to the function.
|
||||
(_, ActionInvoke InvGet) -> targetToJsonRpcParams (rightToMaybe target) rpcQParams
|
||||
(_, ActionInvoke InvHead) -> targetToJsonRpcParams (rightToMaybe target) rpcQParams
|
||||
(_, ActionInvoke InvGet) -> targetToJsonRpcParams (rightToMaybe target) qsParams
|
||||
(_, ActionInvoke InvHead) -> targetToJsonRpcParams (rightToMaybe target) qsParams
|
||||
(CTUrlEncoded, ActionInvoke InvPost) -> targetToJsonRpcParams (rightToMaybe target) $ (T.decodeUtf8 *** T.decodeUtf8) <$> parseSimpleQuery (LBS.toStrict reqBody)
|
||||
_ | shouldParsePayload -> rightToMaybe payload
|
||||
| otherwise -> Nothing
|
||||
@@ -349,7 +322,6 @@ userApiRequest conf@AppConfig{..} dbStructure req reqBody
|
||||
_ -> PathUnknown
|
||||
method = requestMethod req
|
||||
hdrs = requestHeaders req
|
||||
qParams = [(T.decodeUtf8 k, T.decodeUtf8 <$> v)|(k,v) <- qString]
|
||||
lookupHeader = flip lookup hdrs
|
||||
Preferences.Preferences{..} = Preferences.fromHeaders hdrs
|
||||
auth = fromMaybe "" $ lookupHeader hAuthorization
|
||||
@@ -357,24 +329,9 @@ userApiRequest conf@AppConfig{..} dbStructure req reqBody
|
||||
("Bearer" : t : _) -> t
|
||||
("bearer" : t : _) -> t
|
||||
_ -> ""
|
||||
endingIn:: [Text] -> Text -> Bool
|
||||
endingIn xx key = lastWord `elem` xx
|
||||
where lastWord = last $ T.split (=='.') key
|
||||
|
||||
headerRange = rangeRequested hdrs
|
||||
replaceLast x s = T.intercalate "." $ L.init (T.split (=='.') s) ++ [x]
|
||||
limitParams :: M.HashMap Text NonnegRange
|
||||
limitParams = M.fromList [(toS (replaceLast "limit" k), restrictRange (readMaybe . toS =<< v) allRange) | (k,v) <- qParams, isJust v, endingIn ["limit"] k]
|
||||
offsetParams :: M.HashMap Text NonnegRange
|
||||
offsetParams = M.fromList [(toS (replaceLast "limit" k), maybe allRange rangeGeq (readMaybe . toS =<< v)) | (k,v) <- qParams, isJust v, endingIn ["offset"] k]
|
||||
|
||||
urlRange = M.unionWith f limitParams offsetParams
|
||||
where
|
||||
f rl ro = Range (BoundaryBelow o) (BoundaryAbove $ o + l - 1)
|
||||
where
|
||||
l = fromMaybe 0 $ rangeLimit rl
|
||||
o = rangeOffset ro
|
||||
ranges = M.insert "limit" (rangeIntersection headerRange (fromMaybe allRange (M.lookup "limit" urlRange))) urlRange
|
||||
ranges = M.insert "limit" (rangeIntersection headerRange (fromMaybe allRange (M.lookup "limit" qsRanges))) qsRanges
|
||||
|
||||
{-|
|
||||
Find the best match from a list of content types accepted by the
|
||||
|
||||
@@ -24,10 +24,8 @@ module PostgREST.Request.DbRequestBuilder
|
||||
import qualified Data.HashMap.Strict as M
|
||||
import qualified Data.Set as S
|
||||
|
||||
import Control.Arrow ((***))
|
||||
import Data.Either.Combinators (mapLeft)
|
||||
import Data.List (delete)
|
||||
import Data.Text (isInfixOf)
|
||||
import Data.Tree (Tree (..))
|
||||
|
||||
import PostgREST.DbStructure.Identifiers (FieldName,
|
||||
@@ -41,20 +39,20 @@ import PostgREST.DbStructure.Relationship (Cardinality (..),
|
||||
Relationship (..))
|
||||
import PostgREST.DbStructure.Table (Column (..), Table (..),
|
||||
tableQi)
|
||||
import PostgREST.Error (ApiRequestError (..),
|
||||
Error (..))
|
||||
import PostgREST.Error (Error (..))
|
||||
import PostgREST.Query.SqlFragment (sourceCTEName)
|
||||
import PostgREST.RangeQuery (NonnegRange, allRange,
|
||||
restrictRange)
|
||||
import PostgREST.Request.ApiRequest (Action (..),
|
||||
ApiRequest (..),
|
||||
InvokeMethod (..),
|
||||
Payload (..))
|
||||
|
||||
import PostgREST.Request.Parsers
|
||||
import PostgREST.Request.Preferences
|
||||
import PostgREST.Request.Types
|
||||
|
||||
import qualified PostgREST.DbStructure.Relationship as Relationship
|
||||
import qualified PostgREST.Request.QueryParams as QueryParams
|
||||
|
||||
import Protolude hiding (from)
|
||||
|
||||
@@ -66,9 +64,9 @@ readRequest schema rootTableName maxRows allRels apiRequest =
|
||||
mapLeft ApiRequestError $
|
||||
treeRestrictRange maxRows =<<
|
||||
augmentRequestWithJoin schema rootRels =<<
|
||||
(addFiltersOrdersRanges apiRequest . initReadRequest rootName =<< pRequestSelect sel)
|
||||
addFiltersOrdersRanges apiRequest (initReadRequest rootName sel)
|
||||
where
|
||||
sel = fromMaybe "*" $ iSelect apiRequest -- default to all columns requested (SELECT *) for a non existent ?select querystring param
|
||||
sel = QueryParams.qsSelect $ iQueryParams apiRequest
|
||||
(rootName, rootRels) = rootWithRels schema rootTableName allRels (iAction apiRequest)
|
||||
|
||||
-- Get the root table name with its relationships according to the Action type.
|
||||
@@ -254,27 +252,22 @@ getJoinConditions previousAlias newAlias (Relationship Table{tableSchema=tSchema
|
||||
removeSourceCTESchema schema tbl = QualifiedIdentifier (if tbl == decodeUtf8 sourceCTEName then mempty else schema) tbl
|
||||
|
||||
addFiltersOrdersRanges :: ApiRequest -> ReadRequest -> Either ApiRequestError ReadRequest
|
||||
addFiltersOrdersRanges apiRequest rReq = do
|
||||
rFlts <- foldr addFilter rReq <$> filters
|
||||
rOrds <- foldr addOrder rFlts <$> orders
|
||||
rRngs <- foldr addRange rOrds <$> ranges
|
||||
foldr addLogicTree rRngs <$> logicForest
|
||||
addFiltersOrdersRanges ApiRequest{..} rReq = do
|
||||
flip (foldr addLogicTree) qsLogic <$> (foldr addRange rOrds <$> ranges)
|
||||
where
|
||||
filters :: Either ApiRequestError [(EmbedPath, Filter)]
|
||||
filters = pRequestFilter `traverse` flts
|
||||
orders :: Either ApiRequestError [(EmbedPath, [OrderTerm])]
|
||||
orders = pRequestOrder `traverse` iOrder apiRequest
|
||||
rFlts = foldr addFilter rReq flts
|
||||
rOrds = foldr addOrder rFlts qsOrder
|
||||
QueryParams.QueryParams{..} = iQueryParams
|
||||
ranges :: Either ApiRequestError [(EmbedPath, NonnegRange)]
|
||||
ranges = pRequestRange `traverse` M.toList (iRange apiRequest)
|
||||
logicForest :: Either ApiRequestError [(EmbedPath, LogicTree)]
|
||||
logicForest = pRequestLogicTree `traverse` logFrst
|
||||
action = iAction apiRequest
|
||||
ranges = first QueryParamError $ QueryParams.pRequestRange `traverse` M.toList iRange
|
||||
-- there can be no filters on the root table when we are doing insert/update/delete
|
||||
(flts, logFrst) =
|
||||
case action of
|
||||
ActionInvoke _ -> (iFilters apiRequest, iLogic apiRequest)
|
||||
ActionRead _ -> (iFilters apiRequest, iLogic apiRequest)
|
||||
_ -> join (***) (filter (( "." `isInfixOf` ) . fst)) (iFilters apiRequest, iLogic apiRequest)
|
||||
flts =
|
||||
case iAction of
|
||||
ActionInvoke InvGet -> qsFilters
|
||||
ActionInvoke InvHead -> qsFilters
|
||||
ActionInvoke _ -> qsFilters
|
||||
ActionRead _ -> qsFilters
|
||||
_ -> qsFiltersNotRoot
|
||||
|
||||
addFilterToNode :: Filter -> ReadRequest -> ReadRequest
|
||||
addFilterToNode flt (Node (q@Select {where_=lf}, i) f) = Node (q{where_=addFilterToLogicForest flt lf}::ReadQuery, i) f
|
||||
@@ -310,41 +303,36 @@ addProperty f (targetNodeName:remainingPath, a) (Node rn forest) =
|
||||
pathNode = find (\(Node (_,(nodeName,_,alias,_,_, _)) _) -> nodeName == targetNodeName || alias == Just targetNodeName) forest
|
||||
|
||||
mutateRequest :: Schema -> TableName -> ApiRequest -> [FieldName] -> ReadRequest -> Either Error MutateRequest
|
||||
mutateRequest schema tName apiRequest pkCols readReq = mapLeft ApiRequestError $
|
||||
case action of
|
||||
ActionCreate -> do
|
||||
confCols <- case iOnConflict apiRequest of
|
||||
Nothing -> pure pkCols
|
||||
Just param -> pRequestOnConflict param
|
||||
pure $ Insert qi (iColumns apiRequest) body ((,) <$> iPreferResolution apiRequest <*> Just confCols) [] returnings
|
||||
ActionUpdate -> Update qi (iColumns apiRequest) body <$> combinedLogic <*> pure returnings
|
||||
mutateRequest schema tName ApiRequest{..} pkCols readReq = mapLeft ApiRequestError $
|
||||
case iAction of
|
||||
ActionCreate ->
|
||||
Right $ Insert qi iColumns body ((,) <$> iPreferResolution <*> Just confCols) [] returnings
|
||||
ActionUpdate -> Right $ Update qi iColumns body combinedLogic returnings
|
||||
ActionSingleUpsert ->
|
||||
(\flts ->
|
||||
if null (iLogic apiRequest) &&
|
||||
S.fromList (fst <$> iFilters apiRequest) == S.fromList pkCols &&
|
||||
if null qsLogic &&
|
||||
qsFilterFields == S.fromList pkCols &&
|
||||
not (null (S.fromList pkCols)) &&
|
||||
all (\case
|
||||
Filter _ (OpExpr False (Op "eq" _)) -> True
|
||||
_ -> False) flts
|
||||
then Insert qi (iColumns apiRequest) body (Just (MergeDuplicates, pkCols)) <$> combinedLogic <*> pure returnings
|
||||
Filter _ (OpExpr False (Op OpEqual _)) -> True
|
||||
_ -> False) filters
|
||||
then Right $ Insert qi iColumns body (Just (MergeDuplicates, pkCols)) combinedLogic returnings
|
||||
else
|
||||
Left InvalidFilters) =<< filters
|
||||
ActionDelete -> Delete qi <$> combinedLogic <*> pure returnings
|
||||
Left InvalidFilters
|
||||
ActionDelete -> Right $ Delete qi combinedLogic returnings
|
||||
_ -> Left UnsupportedVerb
|
||||
where
|
||||
confCols = fromMaybe pkCols qsOnConflict
|
||||
QueryParams.QueryParams{..} = iQueryParams
|
||||
qi = QualifiedIdentifier schema tName
|
||||
action = iAction apiRequest
|
||||
returnings =
|
||||
if iPreferRepresentation apiRequest == None
|
||||
if iPreferRepresentation == None
|
||||
then []
|
||||
else returningCols readReq pkCols
|
||||
filters = map snd <$> pRequestFilter `traverse` mutateFilters
|
||||
logic = map snd <$> pRequestLogicTree `traverse` logicFilters
|
||||
combinedLogic = foldr addFilterToLogicForest <$> logic <*> filters
|
||||
-- update/delete filters can be only on the root table
|
||||
(mutateFilters, logicFilters) = join (***) onlyRoot (iFilters apiRequest, iLogic apiRequest)
|
||||
onlyRoot = filter (not . ( "." `isInfixOf` ) . fst)
|
||||
body = payRaw <$> iPayload apiRequest -- the body is assumed to be json at this stage(ApiRequest validates)
|
||||
filters = map snd qsFiltersRoot
|
||||
logic = map snd qsLogic
|
||||
combinedLogic = foldr addFilterToLogicForest logic filters
|
||||
body = payRaw <$> iPayload -- the body is assumed to be json at this stage(ApiRequest validates)
|
||||
|
||||
callRequest :: ProcDescription -> ApiRequest -> ReadRequest -> CallRequest
|
||||
callRequest proc apiReq readReq = FunctionCall {
|
||||
|
||||
@@ -1,300 +0,0 @@
|
||||
{-|
|
||||
Module : PostgREST.Request.Parsers
|
||||
Description : PostgREST parser combinators
|
||||
|
||||
This module is in charge of parsing all the querystring values in an url, e.g. the select, id, order in `/projects?select=id,name&id=eq.1&order=id,name.desc`.
|
||||
-}
|
||||
module PostgREST.Request.Parsers
|
||||
( pColumns
|
||||
, pLogicPath
|
||||
, pLogicSingleVal
|
||||
, pLogicTree
|
||||
, pOrder
|
||||
, pOrderTerm
|
||||
, pRequestColumns
|
||||
, pRequestFilter
|
||||
, pRequestLogicTree
|
||||
, pRequestOnConflict
|
||||
, pRequestOrder
|
||||
, pRequestRange
|
||||
, pRequestSelect
|
||||
, pSingleVal
|
||||
, pTreePath
|
||||
) where
|
||||
|
||||
import qualified Data.HashMap.Strict as M
|
||||
import qualified Data.Set as S
|
||||
|
||||
import Data.Either.Combinators (mapLeft)
|
||||
import Data.Foldable (foldl1)
|
||||
import Data.List (init, last)
|
||||
import Data.Text (intercalate, replace, strip)
|
||||
import Data.Tree (Tree (..))
|
||||
import Text.Parsec.Error (errorMessages,
|
||||
showErrorMessages)
|
||||
import Text.ParserCombinators.Parsec (GenParser, ParseError, Parser,
|
||||
anyChar, between, char, digit,
|
||||
eof, errorPos, letter,
|
||||
lookAhead, many1, noneOf,
|
||||
notFollowedBy, oneOf, option,
|
||||
optionMaybe, parse, sepBy1,
|
||||
string, try, (<?>))
|
||||
|
||||
import PostgREST.DbStructure.Identifiers (FieldName)
|
||||
import PostgREST.Error (ApiRequestError (ParseRequestError))
|
||||
import PostgREST.Query.SqlFragment (ftsOperators, operators)
|
||||
import PostgREST.RangeQuery (NonnegRange)
|
||||
|
||||
import PostgREST.Request.Types
|
||||
|
||||
import Protolude hiding (intercalate, option, replace, try)
|
||||
|
||||
pRequestSelect :: Text -> Either ApiRequestError [Tree SelectItem]
|
||||
pRequestSelect selStr =
|
||||
mapError $ parse pFieldForest ("failed to parse select parameter (" <> toS selStr <> ")") (toS selStr)
|
||||
|
||||
pRequestOnConflict :: Text -> Either ApiRequestError [FieldName]
|
||||
pRequestOnConflict oncStr =
|
||||
mapError $ parse pColumns ("failed to parse on_conflict parameter (" <> toS oncStr <> ")") (toS oncStr)
|
||||
|
||||
pRequestFilter :: (Text, Text) -> Either ApiRequestError (EmbedPath, Filter)
|
||||
pRequestFilter (k, v) = mapError $ (,) <$> path <*> (Filter <$> fld <*> oper)
|
||||
where
|
||||
treePath = parse pTreePath ("failed to parser tree path (" ++ toS k ++ ")") $ toS k
|
||||
oper = parse (pOpExpr pSingleVal) ("failed to parse filter (" ++ toS v ++ ")") $ toS v
|
||||
path = fst <$> treePath
|
||||
fld = snd <$> treePath
|
||||
|
||||
pRequestOrder :: (Text, Text) -> Either ApiRequestError (EmbedPath, [OrderTerm])
|
||||
pRequestOrder (k, v) = mapError $ (,) <$> path <*> ord'
|
||||
where
|
||||
treePath = parse pTreePath ("failed to parser tree path (" ++ toS k ++ ")") $ toS k
|
||||
path = fst <$> treePath
|
||||
ord' = parse pOrder ("failed to parse order (" ++ toS v ++ ")") $ toS v
|
||||
|
||||
pRequestRange :: (Text, NonnegRange) -> Either ApiRequestError (EmbedPath, NonnegRange)
|
||||
pRequestRange (k, v) = mapError $ (,) <$> path <*> pure v
|
||||
where
|
||||
treePath = parse pTreePath ("failed to parser tree path (" ++ toS k ++ ")") $ toS k
|
||||
path = fst <$> treePath
|
||||
|
||||
pRequestLogicTree :: (Text, Text) -> Either ApiRequestError (EmbedPath, LogicTree)
|
||||
pRequestLogicTree (k, v) = mapError $ (,) <$> embedPath <*> logicTree
|
||||
where
|
||||
path = parse pLogicPath ("failed to parser logic path (" ++ toS k ++ ")") $ toS k
|
||||
embedPath = fst <$> path
|
||||
logicTree = do
|
||||
op <- snd <$> path
|
||||
-- Concat op and v to make pLogicTree argument regular,
|
||||
-- in the form of "?and=and(.. , ..)" instead of "?and=(.. , ..)"
|
||||
parse pLogicTree ("failed to parse logic tree (" ++ toS v ++ ")") $ toS (op <> v)
|
||||
|
||||
pRequestColumns :: Maybe Text -> Either ApiRequestError (Maybe (S.Set FieldName))
|
||||
pRequestColumns colStr =
|
||||
case colStr of
|
||||
Just str ->
|
||||
mapError $ Just . S.fromList <$> parse pColumns ("failed to parse columns parameter (" <> toS str <> ")") (toS str)
|
||||
_ -> Right Nothing
|
||||
|
||||
ws :: Parser Text
|
||||
ws = toS <$> many (oneOf " \t")
|
||||
|
||||
lexeme :: Parser a -> Parser a
|
||||
lexeme p = ws *> p <* ws
|
||||
|
||||
pTreePath :: Parser (EmbedPath, Field)
|
||||
pTreePath = do
|
||||
p <- pFieldName `sepBy1` pDelimiter
|
||||
jp <- option [] pJsonPath
|
||||
return (init p, (last p, jp))
|
||||
|
||||
pFieldForest :: Parser [Tree SelectItem]
|
||||
pFieldForest = pFieldTree `sepBy1` lexeme (char ',')
|
||||
where
|
||||
pFieldTree :: Parser (Tree SelectItem)
|
||||
pFieldTree = try (Node <$> pRelationSelect <*> between (char '(') (char ')') pFieldForest) <|>
|
||||
Node <$> pFieldSelect <*> pure []
|
||||
|
||||
pStar :: Parser Text
|
||||
pStar = string "*" $> "*"
|
||||
|
||||
pFieldName :: Parser Text
|
||||
pFieldName =
|
||||
pQuotedValue <|>
|
||||
intercalate "-" . map toS <$> (many1 (letter <|> digit <|> oneOf "_ ") `sepBy1` dash) <?>
|
||||
"field name (* or [a..z0..9_])"
|
||||
where
|
||||
isDash :: GenParser Char st ()
|
||||
isDash = try ( char '-' >> notFollowedBy (char '>') )
|
||||
dash :: Parser Char
|
||||
dash = isDash $> '-'
|
||||
|
||||
pJsonPath :: Parser JsonPath
|
||||
pJsonPath = many pJsonOperation
|
||||
where
|
||||
pJsonOperation :: Parser JsonOperation
|
||||
pJsonOperation = pJsonArrow <*> pJsonOperand
|
||||
|
||||
pJsonArrow =
|
||||
try (string "->>" $> J2Arrow) <|>
|
||||
try (string "->" $> JArrow)
|
||||
|
||||
pJsonOperand =
|
||||
let pJKey = JKey . toS <$> pFieldName
|
||||
pJIdx = JIdx . toS <$> ((:) <$> option '+' (char '-') <*> many1 digit) <* pEnd
|
||||
pEnd = try (void $ lookAhead (string "->")) <|>
|
||||
try (void $ lookAhead (string "::")) <|>
|
||||
try eof in
|
||||
try pJIdx <|> try pJKey
|
||||
|
||||
pField :: Parser Field
|
||||
pField = lexeme $ (,) <$> pFieldName <*> option [] pJsonPath
|
||||
|
||||
aliasSeparator :: Parser ()
|
||||
aliasSeparator = char ':' >> notFollowedBy (char ':')
|
||||
|
||||
pRelationSelect :: Parser SelectItem
|
||||
pRelationSelect = lexeme $ try ( do
|
||||
alias <- optionMaybe ( try(pFieldName <* aliasSeparator) )
|
||||
fld <- pField
|
||||
prm1 <- optionMaybe pEmbedParam
|
||||
prm2 <- optionMaybe pEmbedParam
|
||||
return (fld, Nothing, alias, embedParamHint prm1 <|> embedParamHint prm2, embedParamJoin prm1 <|> embedParamJoin prm2)
|
||||
)
|
||||
where
|
||||
pEmbedParam :: Parser EmbedParam
|
||||
pEmbedParam =
|
||||
char '!' *> (
|
||||
try (string "left" $> EPJoinType JTLeft) <|>
|
||||
try (string "inner" $> EPJoinType JTInner) <|>
|
||||
try (EPHint <$> pFieldName))
|
||||
embedParamHint prm = case prm of
|
||||
Just (EPHint hint) -> Just hint
|
||||
_ -> Nothing
|
||||
embedParamJoin prm = case prm of
|
||||
Just (EPJoinType jt) -> Just jt
|
||||
_ -> Nothing
|
||||
|
||||
pFieldSelect :: Parser SelectItem
|
||||
pFieldSelect = lexeme $
|
||||
try (
|
||||
do
|
||||
alias <- optionMaybe ( try(pFieldName <* aliasSeparator) )
|
||||
fld <- pField
|
||||
cast' <- optionMaybe (string "::" *> many letter)
|
||||
return (fld, toS <$> cast', alias, Nothing, Nothing)
|
||||
)
|
||||
<|> do
|
||||
s <- pStar
|
||||
return ((s, []), Nothing, Nothing, Nothing, Nothing)
|
||||
|
||||
pOpExpr :: Parser SingleVal -> Parser OpExpr
|
||||
pOpExpr pSVal = try ( string "not" *> pDelimiter *> (OpExpr True <$> pOperation)) <|> OpExpr False <$> pOperation
|
||||
where
|
||||
pOperation :: Parser Operation
|
||||
pOperation =
|
||||
Op . toS <$> foldl1 (<|>) (try . ((<* pDelimiter) . string) . toS <$> M.keys ops) <*> pSVal
|
||||
<|> In <$> (try (string "in" *> pDelimiter) *> pListVal)
|
||||
<|> Is <$> (try (string "is" *> pDelimiter) *> pTriVal)
|
||||
<|> pFts
|
||||
<?> "operator (eq, gt, ...)"
|
||||
|
||||
pTriVal = try (ciString "null" $> TriNull)
|
||||
<|> try (ciString "unknown" $> TriUnknown)
|
||||
<|> try (ciString "true" $> TriTrue)
|
||||
<|> try (ciString "false" $> TriFalse)
|
||||
<?> "null or trilean value (unknown, true, false)"
|
||||
|
||||
pFts = do
|
||||
op <- foldl1 (<|>) (try . string . toS <$> ftsOps)
|
||||
lang <- optionMaybe $ try (between (char '(') (char ')') (many (letter <|> digit <|> oneOf "_")))
|
||||
pDelimiter >> Fts (toS op) (toS <$> lang) <$> pSVal
|
||||
|
||||
ops = M.filterWithKey (const . flip notElem ("in":"is":ftsOps)) operators
|
||||
ftsOps = M.keys ftsOperators
|
||||
|
||||
-- case insensitive char and string
|
||||
ciChar :: Char -> GenParser Char state Char
|
||||
ciChar c = char c <|> char (toUpper c)
|
||||
ciString :: [Char] -> GenParser Char state [Char]
|
||||
ciString = traverse ciChar
|
||||
|
||||
pSingleVal :: Parser SingleVal
|
||||
pSingleVal = toS <$> many anyChar
|
||||
|
||||
pListVal :: Parser ListVal
|
||||
pListVal = lexeme (char '(') *> pListElement `sepBy1` char ',' <* lexeme (char ')')
|
||||
|
||||
pListElement :: Parser Text
|
||||
pListElement = try (pQuotedValue <* notFollowedBy (noneOf ",)")) <|> (toS <$> many (noneOf ",)"))
|
||||
|
||||
pQuotedValue :: Parser Text
|
||||
pQuotedValue = toS <$> (char '"' *> many pCharsOrSlashed <* char '"')
|
||||
where
|
||||
pCharsOrSlashed = noneOf "\\\"" <|> (char '\\' *> anyChar)
|
||||
|
||||
pDelimiter :: Parser Char
|
||||
pDelimiter = char '.' <?> "delimiter (.)"
|
||||
|
||||
pOrder :: Parser [OrderTerm]
|
||||
pOrder = lexeme pOrderTerm `sepBy1` char ','
|
||||
|
||||
pOrderTerm :: Parser OrderTerm
|
||||
pOrderTerm = do
|
||||
fld <- pField
|
||||
dir <- optionMaybe $
|
||||
try (pDelimiter *> string "asc" $> OrderAsc) <|>
|
||||
try (pDelimiter *> string "desc" $> OrderDesc)
|
||||
nls <- optionMaybe pNulls <* pEnd <|>
|
||||
pEnd $> Nothing
|
||||
return $ OrderTerm fld dir nls
|
||||
where
|
||||
pNulls = try (pDelimiter *> string "nullsfirst" $> OrderNullsFirst) <|>
|
||||
try (pDelimiter *> string "nullslast" $> OrderNullsLast)
|
||||
pEnd = try (void $ lookAhead (char ',')) <|>
|
||||
try eof
|
||||
|
||||
pLogicTree :: Parser LogicTree
|
||||
pLogicTree = Stmnt <$> try pLogicFilter
|
||||
<|> Expr <$> pNot <*> pLogicOp <*> (lexeme (char '(') *> pLogicTree `sepBy1` lexeme (char ',') <* lexeme (char ')'))
|
||||
where
|
||||
pLogicFilter :: Parser Filter
|
||||
pLogicFilter = Filter <$> pField <* pDelimiter <*> pOpExpr pLogicSingleVal
|
||||
pNot :: Parser Bool
|
||||
pNot = try (string "not" *> pDelimiter $> True)
|
||||
<|> pure False
|
||||
<?> "negation operator (not)"
|
||||
pLogicOp :: Parser LogicOperator
|
||||
pLogicOp = try (string "and" $> And)
|
||||
<|> string "or" $> Or
|
||||
<?> "logic operator (and, or)"
|
||||
|
||||
pLogicSingleVal :: Parser SingleVal
|
||||
pLogicSingleVal = try (pQuotedValue <* notFollowedBy (noneOf ",)")) <|> try pPgArray <|> (toS <$> many (noneOf ",)"))
|
||||
where
|
||||
pPgArray :: Parser Text
|
||||
pPgArray = do
|
||||
a <- string "{"
|
||||
b <- many (noneOf "{}")
|
||||
c <- string "}"
|
||||
pure (toS $ a ++ b ++ c)
|
||||
|
||||
pLogicPath :: Parser (EmbedPath, Text)
|
||||
pLogicPath = do
|
||||
path <- pFieldName `sepBy1` pDelimiter
|
||||
let op = last path
|
||||
notOp = "not." <> op
|
||||
return (filter (/= "not") (init path), if "not" `elem` path then notOp else op)
|
||||
|
||||
pColumns :: Parser [FieldName]
|
||||
pColumns = pFieldName `sepBy1` lexeme (char ',')
|
||||
|
||||
mapError :: Either ParseError a -> Either ApiRequestError a
|
||||
mapError = mapLeft translateError
|
||||
where
|
||||
translateError e =
|
||||
ParseRequestError message details
|
||||
where
|
||||
message = show $ errorPos e
|
||||
details = strip $ replace "\n" " " $ toS
|
||||
$ showErrorMessages "or" "unknown parse error" "expecting" "unexpected" "end of input" (errorMessages e)
|
||||
@@ -0,0 +1,495 @@
|
||||
-- |
|
||||
-- Module : PostgREST.Request.QueryParams
|
||||
-- Description : Parser for PostgREST Query paramters
|
||||
--
|
||||
-- This module is in charge of parsing all the querystring values in an url, e.g.
|
||||
-- the select, id, order in `/projects?select=id,name&id=eq.1&order=id,name.desc`.
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE TupleSections #-}
|
||||
module PostgREST.Request.QueryParams
|
||||
( parse
|
||||
, QueryParams(..)
|
||||
, pRequestRange
|
||||
) where
|
||||
|
||||
import qualified Data.ByteString.Char8 as BS
|
||||
import qualified Data.HashMap.Strict as M
|
||||
import qualified Data.List as L
|
||||
import qualified Data.Set as S
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.Encoding as T
|
||||
import qualified Network.HTTP.Base as HTTP
|
||||
import qualified Network.HTTP.Types.URI as HTTP
|
||||
import qualified Text.ParserCombinators.Parsec as P
|
||||
|
||||
import Control.Arrow ((***))
|
||||
import Data.Either.Combinators (mapLeft)
|
||||
import Data.List (init, last)
|
||||
import Data.Ranged.Boundaries (Boundary (..))
|
||||
import Data.Ranged.Ranges (Range (..))
|
||||
import Data.Tree (Tree (..))
|
||||
import Text.Parsec.Error (errorMessages,
|
||||
showErrorMessages)
|
||||
import Text.Parsec.Prim (parserFail)
|
||||
import Text.ParserCombinators.Parsec (GenParser, ParseError, Parser,
|
||||
anyChar, between, char, digit,
|
||||
eof, errorPos, letter,
|
||||
lookAhead, many1, noneOf,
|
||||
notFollowedBy, oneOf,
|
||||
optionMaybe, sepBy1, string,
|
||||
try, (<?>))
|
||||
|
||||
import PostgREST.DbStructure.Identifiers (FieldName)
|
||||
import PostgREST.RangeQuery (NonnegRange, allRange,
|
||||
rangeGeq, rangeLimit,
|
||||
rangeOffset, restrictRange)
|
||||
|
||||
import PostgREST.Request.Types (EmbedParam (..), EmbedPath, Field,
|
||||
Filter (..), FtsOperator (..),
|
||||
JoinType (..), JsonOperand (..),
|
||||
JsonOperation (..), JsonPath, ListVal,
|
||||
LogicOperator (..), LogicTree (..),
|
||||
OpExpr (..), Operation (..),
|
||||
OrderDirection (..), OrderNulls (..),
|
||||
OrderTerm (..), QPError (..),
|
||||
SelectItem, SingleVal,
|
||||
SimpleOperator (..),
|
||||
TrileanVal (..))
|
||||
|
||||
import Protolude hiding (try)
|
||||
|
||||
|
||||
-- $setup
|
||||
-- Setup for doctests
|
||||
-- >>> import Text.Pretty.Simple (pPrint)
|
||||
-- >>> deriving instance Show QPError
|
||||
-- >>> deriving instance Show TrileanVal
|
||||
-- >>> deriving instance Show FtsOperator
|
||||
-- >>> deriving instance Show SimpleOperator
|
||||
-- >>> deriving instance Show Operation
|
||||
-- >>> deriving instance Show OpExpr
|
||||
-- >>> deriving instance Show JsonOperand
|
||||
-- >>> deriving instance Show JsonOperation
|
||||
-- >>> deriving instance Show Filter
|
||||
-- >>> deriving instance Show JoinType
|
||||
|
||||
data QueryParams =
|
||||
QueryParams
|
||||
{ qsCanonical :: ByteString
|
||||
-- ^ Canonical representation of the query params, sorted alphabetically
|
||||
, qsParams :: [(Text, Text)]
|
||||
-- ^ Parameters for RPC calls
|
||||
, qsRanges :: M.HashMap Text (Range Integer)
|
||||
-- ^ Ranges derived from &limit and &offset params
|
||||
, qsOrder :: [(EmbedPath, [OrderTerm])]
|
||||
-- ^ &order parameters for each level
|
||||
, qsLogic :: [(EmbedPath, LogicTree)]
|
||||
-- ^ &and and &or parameters used for complex boolean logic
|
||||
, qsColumns :: Maybe (S.Set FieldName)
|
||||
-- ^ &columns parameter and payload
|
||||
, qsSelect :: [Tree SelectItem]
|
||||
-- ^ &select parameter used to shape the response
|
||||
, qsFilters :: [(EmbedPath, Filter)]
|
||||
-- ^ Filters on the result from e.g. &id=e.10
|
||||
, qsFiltersRoot :: [(EmbedPath, Filter)]
|
||||
-- ^ Subset of the filters that apply on the root table
|
||||
, qsFiltersNotRoot :: [(EmbedPath, Filter)]
|
||||
-- ^ Subset of the filters that do not apply on the root table
|
||||
, qsFilterFields :: S.Set FieldName
|
||||
-- ^ Set of fields that filters apply to
|
||||
, qsOnConflict :: Maybe [FieldName]
|
||||
-- ^ &on_conflict parameter used to upsert on specific unique keys
|
||||
}
|
||||
|
||||
-- |
|
||||
-- Parse query parameters from a query string like "id=eq.1&select=name".
|
||||
--
|
||||
-- The canonical representation of the query string has paramters sorted alphabetically:
|
||||
--
|
||||
-- >>> qsCanonical <$> parse "a=1&c=3&b=2&d"
|
||||
-- Right "a=1&b=2&c=3&d="
|
||||
--
|
||||
-- 'select' is a reserved parameter that selects the fields to be returned:
|
||||
--
|
||||
-- >>> qsSelect <$> parse "select=name,location"
|
||||
-- Right [Node {rootLabel = (("name",[]),Nothing,Nothing,Nothing,Nothing), subForest = []},Node {rootLabel = (("location",[]),Nothing,Nothing,Nothing,Nothing), subForest = []}]
|
||||
--
|
||||
-- Filters are parameters whose value contains an operator, separated by a '.' from its value:
|
||||
--
|
||||
-- >>> qsFilters <$> parse "a.b=eq.0"
|
||||
-- Right [(["a"],Filter {field = ("b",[]), opExpr = OpExpr False (Op OpEqual "0")})]
|
||||
--
|
||||
-- If the operator specified in a filter does not exist, parsing the query string fails:
|
||||
--
|
||||
-- >>> qsFilters <$> parse "a.b=noop.0"
|
||||
-- Left (QPError "\"failed to parse filter (noop.0)\" (line 1, column 6)" "unknown single value operator noop")
|
||||
parse :: ByteString -> Either QPError QueryParams
|
||||
parse qs =
|
||||
QueryParams
|
||||
canonical
|
||||
params
|
||||
ranges
|
||||
<$> pRequestOrder `traverse` order
|
||||
<*> pRequestLogicTree `traverse` logic
|
||||
<*> pRequestColumns columns
|
||||
<*> pRequestSelect select
|
||||
<*> pRequestFilter `traverse` filters
|
||||
<*> pRequestFilter `traverse` filtersRoot
|
||||
<*> pRequestFilter `traverse` filtersNotRoot
|
||||
<*> pure (S.fromList (fst <$> filters))
|
||||
<*> sequenceA (pRequestOnConflict <$> onConflict)
|
||||
where
|
||||
logic = filter (endingIn ["and", "or"] . fst) nonemptyParams
|
||||
select = fromMaybe "*" $ lookupParam "select"
|
||||
onConflict = lookupParam "on_conflict"
|
||||
columns = lookupParam "columns"
|
||||
order = filter (endingIn ["order"] . fst) nonemptyParams
|
||||
limits = filter (endingIn ["limit"] . fst) nonemptyParams
|
||||
-- Replace .offset ending with .limit to be able to match those params later in a map
|
||||
offsets = first (replaceLast "limit") <$> filter (endingIn ["offset"] . fst) nonemptyParams
|
||||
lookupParam :: Text -> Maybe Text
|
||||
lookupParam needle = toS <$> join (L.lookup needle qParams)
|
||||
nonemptyParams = mapMaybe (\(k, v) -> (k,) <$> v) qParams
|
||||
|
||||
qString = HTTP.parseQueryReplacePlus True qs
|
||||
|
||||
qParams = [(T.decodeUtf8 k, T.decodeUtf8 <$> v)|(k,v) <- qString]
|
||||
|
||||
canonical =
|
||||
BS.pack $ HTTP.urlEncodeVars
|
||||
. L.sortOn fst
|
||||
. map (join (***) BS.unpack . second (fromMaybe mempty))
|
||||
$ qString
|
||||
|
||||
endingIn:: [Text] -> Text -> Bool
|
||||
endingIn xx key = lastWord `elem` xx
|
||||
where lastWord = L.last $ T.split (== '.') key
|
||||
|
||||
(filters, params) = L.partition isParam filtersAndParams
|
||||
isParam (k, v) = isEmbedPath k || hasOperator v || hasFtsOperator v
|
||||
|
||||
filtersAndParams = filter (isFilterOrParam . fst) nonemptyParams
|
||||
isFilterOrParam k = not (endingIn reservedEmbeddable k) && notElem k reserved
|
||||
reserved = ["select", "columns", "on_conflict"]
|
||||
reservedEmbeddable = ["order", "limit", "offset", "and", "or"]
|
||||
|
||||
(filtersNotRoot, filtersRoot) = L.partition isNotRoot filters
|
||||
isNotRoot = flip T.isInfixOf "." . fst
|
||||
|
||||
-- TODO: These checks are redundant to the parsers, should use parsers to differentiate params
|
||||
hasOperator val =
|
||||
case T.splitOn "." val of
|
||||
"not" : _ : _ -> True
|
||||
"is" : _ -> True
|
||||
"in" : _ -> True
|
||||
x : _ -> isJust (operator x) || isJust (ftsOperator x)
|
||||
_ -> False
|
||||
|
||||
hasFtsOperator val =
|
||||
case T.splitOn "(" val of
|
||||
x : _ : _ -> isJust $ ftsOperator x
|
||||
_ -> False
|
||||
|
||||
isEmbedPath = T.isInfixOf "."
|
||||
replaceLast x s = T.intercalate "." $ L.init (T.split (=='.') s) <> [x]
|
||||
|
||||
ranges :: M.HashMap Text (Range Integer)
|
||||
ranges = M.unionWith f limitParams offsetParams
|
||||
where
|
||||
f rl ro = Range (BoundaryBelow o) (BoundaryAbove $ o + l - 1)
|
||||
where
|
||||
l = fromMaybe 0 $ rangeLimit rl
|
||||
o = rangeOffset ro
|
||||
|
||||
limitParams =
|
||||
M.fromList [(k, restrictRange (readMaybe $ toS v) allRange) | (k,v) <- limits]
|
||||
|
||||
offsetParams =
|
||||
M.fromList [(k, maybe allRange rangeGeq (readMaybe $ toS v)) | (k,v) <- offsets]
|
||||
|
||||
operator :: Text -> Maybe SimpleOperator
|
||||
operator = \case
|
||||
"eq" -> Just OpEqual
|
||||
"gte" -> Just OpGreaterThanEqual
|
||||
"gt" -> Just OpGreaterThan
|
||||
"lte" -> Just OpLessThanEqual
|
||||
"lt" -> Just OpLessThan
|
||||
"neq" -> Just OpNotEqual
|
||||
"like" -> Just OpLike
|
||||
"ilike" -> Just OpILike
|
||||
"cs" -> Just OpContains
|
||||
"cd" -> Just OpContained
|
||||
"ov" -> Just OpOverlap
|
||||
"sl" -> Just OpStrictlyLeft
|
||||
"sr" -> Just OpStrictlyRight
|
||||
"nxr" -> Just OpNotExtendsRight
|
||||
"nxl" -> Just OpNotExtendsLeft
|
||||
"adj" -> Just OpAdjacent
|
||||
_ -> Nothing
|
||||
|
||||
ftsOperator :: Text -> Maybe FtsOperator
|
||||
ftsOperator = \case
|
||||
"fts" -> Just FilterFts
|
||||
"plfts" -> Just FilterFtsPlain
|
||||
"phfts" -> Just FilterFtsPhrase
|
||||
"wfts" -> Just FilterFtsWebsearch
|
||||
_ -> Nothing
|
||||
|
||||
|
||||
-- PARSERS
|
||||
|
||||
|
||||
pRequestSelect :: Text -> Either QPError [Tree SelectItem]
|
||||
pRequestSelect selStr =
|
||||
mapError $ P.parse pFieldForest ("failed to parse select parameter (" <> toS selStr <> ")") (toS selStr)
|
||||
|
||||
pRequestOnConflict :: Text -> Either QPError [FieldName]
|
||||
pRequestOnConflict oncStr =
|
||||
mapError $ P.parse pColumns ("failed to parse on_conflict parameter (" <> toS oncStr <> ")") (toS oncStr)
|
||||
|
||||
pRequestFilter :: (Text, Text) -> Either QPError (EmbedPath, Filter)
|
||||
pRequestFilter (k, v) = mapError $ (,) <$> path <*> (Filter <$> fld <*> oper)
|
||||
where
|
||||
treePath = P.parse pTreePath ("failed to parse tree path (" ++ toS k ++ ")") $ toS k
|
||||
oper = P.parse (pOpExpr pSingleVal) ("failed to parse filter (" ++ toS v ++ ")") $ toS v
|
||||
path = fst <$> treePath
|
||||
fld = snd <$> treePath
|
||||
|
||||
pRequestOrder :: (Text, Text) -> Either QPError (EmbedPath, [OrderTerm])
|
||||
pRequestOrder (k, v) = mapError $ (,) <$> path <*> ord'
|
||||
where
|
||||
treePath = P.parse pTreePath ("failed to parse tree path (" ++ toS k ++ ")") $ toS k
|
||||
path = fst <$> treePath
|
||||
ord' = P.parse pOrder ("failed to parse order (" ++ toS v ++ ")") $ toS v
|
||||
|
||||
pRequestRange :: (Text, NonnegRange) -> Either QPError (EmbedPath, NonnegRange)
|
||||
pRequestRange (k, v) = mapError $ (,) <$> path <*> pure v
|
||||
where
|
||||
treePath = P.parse pTreePath ("failed to parse tree path (" ++ toS k ++ ")") $ toS k
|
||||
path = fst <$> treePath
|
||||
|
||||
pRequestLogicTree :: (Text, Text) -> Either QPError (EmbedPath, LogicTree)
|
||||
pRequestLogicTree (k, v) = mapError $ (,) <$> embedPath <*> logicTree
|
||||
where
|
||||
path = P.parse pLogicPath ("failed to parse logic path (" ++ toS k ++ ")") $ toS k
|
||||
embedPath = fst <$> path
|
||||
logicTree = do
|
||||
op <- snd <$> path
|
||||
-- Concat op and v to make pLogicTree argument regular,
|
||||
-- in the form of "?and=and(.. , ..)" instead of "?and=(.. , ..)"
|
||||
P.parse pLogicTree ("failed to parse logic tree (" ++ toS v ++ ")") $ toS (op <> v)
|
||||
|
||||
pRequestColumns :: Maybe Text -> Either QPError (Maybe (S.Set FieldName))
|
||||
pRequestColumns colStr =
|
||||
case colStr of
|
||||
Just str ->
|
||||
mapError $ Just . S.fromList <$> P.parse pColumns ("failed to parse columns parameter (" <> toS str <> ")") (toS str)
|
||||
_ -> Right Nothing
|
||||
|
||||
ws :: Parser Text
|
||||
ws = toS <$> many (oneOf " \t")
|
||||
|
||||
lexeme :: Parser a -> Parser a
|
||||
lexeme p = ws *> p <* ws
|
||||
|
||||
pTreePath :: Parser (EmbedPath, Field)
|
||||
pTreePath = do
|
||||
p <- pFieldName `sepBy1` pDelimiter
|
||||
jp <- P.option [] pJsonPath
|
||||
return (init p, (last p, jp))
|
||||
|
||||
pFieldForest :: Parser [Tree SelectItem]
|
||||
pFieldForest = pFieldTree `sepBy1` lexeme (char ',')
|
||||
where
|
||||
pFieldTree :: Parser (Tree SelectItem)
|
||||
pFieldTree = try (Node <$> pRelationSelect <*> between (char '(') (char ')') pFieldForest) <|>
|
||||
Node <$> pFieldSelect <*> pure []
|
||||
|
||||
pStar :: Parser Text
|
||||
pStar = string "*" $> "*"
|
||||
|
||||
pFieldName :: Parser Text
|
||||
pFieldName =
|
||||
pQuotedValue <|>
|
||||
T.intercalate "-" . map toS <$> (many1 (letter <|> digit <|> oneOf "_ ") `sepBy1` dash) <?>
|
||||
"field name (* or [a..z0..9_])"
|
||||
where
|
||||
isDash :: GenParser Char st ()
|
||||
isDash = try ( char '-' >> notFollowedBy (char '>') )
|
||||
dash :: Parser Char
|
||||
dash = isDash $> '-'
|
||||
|
||||
pJsonPath :: Parser JsonPath
|
||||
pJsonPath = many pJsonOperation
|
||||
where
|
||||
pJsonOperation :: Parser JsonOperation
|
||||
pJsonOperation = pJsonArrow <*> pJsonOperand
|
||||
|
||||
pJsonArrow =
|
||||
try (string "->>" $> J2Arrow) <|>
|
||||
try (string "->" $> JArrow)
|
||||
|
||||
pJsonOperand =
|
||||
let pJKey = JKey . toS <$> pFieldName
|
||||
pJIdx = JIdx . toS <$> ((:) <$> P.option '+' (char '-') <*> many1 digit) <* pEnd
|
||||
pEnd = try (void $ lookAhead (string "->")) <|>
|
||||
try (void $ lookAhead (string "::")) <|>
|
||||
try eof in
|
||||
try pJIdx <|> try pJKey
|
||||
|
||||
pField :: Parser Field
|
||||
pField = lexeme $ (,) <$> pFieldName <*> P.option [] pJsonPath
|
||||
|
||||
aliasSeparator :: Parser ()
|
||||
aliasSeparator = char ':' >> notFollowedBy (char ':')
|
||||
|
||||
pRelationSelect :: Parser SelectItem
|
||||
pRelationSelect = lexeme $ try ( do
|
||||
alias <- optionMaybe ( try(pFieldName <* aliasSeparator) )
|
||||
fld <- pField
|
||||
prm1 <- optionMaybe pEmbedParam
|
||||
prm2 <- optionMaybe pEmbedParam
|
||||
return (fld, Nothing, alias, embedParamHint prm1 <|> embedParamHint prm2, embedParamJoin prm1 <|> embedParamJoin prm2)
|
||||
)
|
||||
where
|
||||
pEmbedParam :: Parser EmbedParam
|
||||
pEmbedParam =
|
||||
char '!' *> (
|
||||
try (string "left" $> EPJoinType JTLeft) <|>
|
||||
try (string "inner" $> EPJoinType JTInner) <|>
|
||||
try (EPHint <$> pFieldName))
|
||||
embedParamHint prm = case prm of
|
||||
Just (EPHint hint) -> Just hint
|
||||
_ -> Nothing
|
||||
embedParamJoin prm = case prm of
|
||||
Just (EPJoinType jt) -> Just jt
|
||||
_ -> Nothing
|
||||
|
||||
pFieldSelect :: Parser SelectItem
|
||||
pFieldSelect = lexeme $
|
||||
try (
|
||||
do
|
||||
alias <- optionMaybe ( try(pFieldName <* aliasSeparator) )
|
||||
fld <- pField
|
||||
cast' <- optionMaybe (string "::" *> many letter)
|
||||
return (fld, toS <$> cast', alias, Nothing, Nothing)
|
||||
)
|
||||
<|> do
|
||||
s <- pStar
|
||||
return ((s, []), Nothing, Nothing, Nothing, Nothing)
|
||||
|
||||
pOpExpr :: Parser SingleVal -> Parser OpExpr
|
||||
pOpExpr pSVal = try ( string "not" *> pDelimiter *> (OpExpr True <$> pOperation)) <|> OpExpr False <$> pOperation
|
||||
where
|
||||
pOperation :: Parser Operation
|
||||
pOperation = pIn <|> pIs <|> try pFts <|> pOp <?> "operator (eq, gt, ...)"
|
||||
|
||||
pIn = In <$> (try (string "in" *> pDelimiter) *> pListVal)
|
||||
pIs = Is <$> (try (string "is" *> pDelimiter) *> pTriVal)
|
||||
|
||||
pOp = do
|
||||
opStr <- try (P.manyTill anyChar (try pDelimiter))
|
||||
op <- parseMaybe ("unknown single value operator " <> opStr) . operator $ toS opStr
|
||||
Op op <$> pSVal
|
||||
|
||||
pTriVal = try (ciString "null" $> TriNull)
|
||||
<|> try (ciString "unknown" $> TriUnknown)
|
||||
<|> try (ciString "true" $> TriTrue)
|
||||
<|> try (ciString "false" $> TriFalse)
|
||||
<?> "null or trilean value (unknown, true, false)"
|
||||
|
||||
pFts = do
|
||||
opStr <- try (P.many (noneOf ".("))
|
||||
op <- parseMaybe ("unknown fts operator " <> opStr) . ftsOperator $ toS opStr
|
||||
lang <- optionMaybe $ try (between (char '(') (char ')') (many (letter <|> digit <|> oneOf "_")))
|
||||
pDelimiter >> Fts op (toS <$> lang) <$> pSVal
|
||||
|
||||
parseMaybe :: [Char] -> Maybe a -> Parser a
|
||||
parseMaybe err Nothing = parserFail err
|
||||
parseMaybe _ (Just x) = pure x
|
||||
|
||||
-- case insensitive char and string
|
||||
ciChar :: Char -> GenParser Char state Char
|
||||
ciChar c = char c <|> char (toUpper c)
|
||||
ciString :: [Char] -> GenParser Char state [Char]
|
||||
ciString = traverse ciChar
|
||||
|
||||
pSingleVal :: Parser SingleVal
|
||||
pSingleVal = toS <$> many anyChar
|
||||
|
||||
pListVal :: Parser ListVal
|
||||
pListVal = lexeme (char '(') *> pListElement `sepBy1` char ',' <* lexeme (char ')')
|
||||
|
||||
pListElement :: Parser Text
|
||||
pListElement = try (pQuotedValue <* notFollowedBy (noneOf ",)")) <|> (toS <$> many (noneOf ",)"))
|
||||
|
||||
pQuotedValue :: Parser Text
|
||||
pQuotedValue = toS <$> (char '"' *> many pCharsOrSlashed <* char '"')
|
||||
where
|
||||
pCharsOrSlashed = noneOf "\\\"" <|> (char '\\' *> anyChar)
|
||||
|
||||
pDelimiter :: Parser Char
|
||||
pDelimiter = char '.' <?> "delimiter (.)"
|
||||
|
||||
pOrder :: Parser [OrderTerm]
|
||||
pOrder = lexeme pOrderTerm `sepBy1` char ','
|
||||
|
||||
pOrderTerm :: Parser OrderTerm
|
||||
pOrderTerm = do
|
||||
fld <- pField
|
||||
dir <- optionMaybe $
|
||||
try (pDelimiter *> string "asc" $> OrderAsc) <|>
|
||||
try (pDelimiter *> string "desc" $> OrderDesc)
|
||||
nls <- optionMaybe pNulls <* pEnd <|>
|
||||
pEnd $> Nothing
|
||||
return $ OrderTerm fld dir nls
|
||||
where
|
||||
pNulls = try (pDelimiter *> string "nullsfirst" $> OrderNullsFirst) <|>
|
||||
try (pDelimiter *> string "nullslast" $> OrderNullsLast)
|
||||
pEnd = try (void $ lookAhead (char ',')) <|>
|
||||
try eof
|
||||
|
||||
pLogicTree :: Parser LogicTree
|
||||
pLogicTree = Stmnt <$> try pLogicFilter
|
||||
<|> Expr <$> pNot <*> pLogicOp <*> (lexeme (char '(') *> pLogicTree `sepBy1` lexeme (char ',') <* lexeme (char ')'))
|
||||
where
|
||||
pLogicFilter :: Parser Filter
|
||||
pLogicFilter = Filter <$> pField <* pDelimiter <*> pOpExpr pLogicSingleVal
|
||||
pNot :: Parser Bool
|
||||
pNot = try (string "not" *> pDelimiter $> True)
|
||||
<|> pure False
|
||||
<?> "negation operator (not)"
|
||||
pLogicOp :: Parser LogicOperator
|
||||
pLogicOp = try (string "and" $> And)
|
||||
<|> string "or" $> Or
|
||||
<?> "logic operator (and, or)"
|
||||
|
||||
pLogicSingleVal :: Parser SingleVal
|
||||
pLogicSingleVal = try (pQuotedValue <* notFollowedBy (noneOf ",)")) <|> try pPgArray <|> (toS <$> many (noneOf ",)"))
|
||||
where
|
||||
pPgArray :: Parser Text
|
||||
pPgArray = do
|
||||
a <- string "{"
|
||||
b <- many (noneOf "{}")
|
||||
c <- string "}"
|
||||
pure (toS $ a ++ b ++ c)
|
||||
|
||||
pLogicPath :: Parser (EmbedPath, Text)
|
||||
pLogicPath = do
|
||||
path <- pFieldName `sepBy1` pDelimiter
|
||||
let op = last path
|
||||
notOp = "not." <> op
|
||||
return (filter (/= "not") (init path), if "not" `elem` path then notOp else op)
|
||||
|
||||
pColumns :: Parser [FieldName]
|
||||
pColumns = pFieldName `sepBy1` lexeme (char ',')
|
||||
|
||||
mapError :: Either ParseError a -> Either QPError a
|
||||
mapError = mapLeft translateError
|
||||
where
|
||||
translateError e =
|
||||
QPError message details
|
||||
where
|
||||
message = show $ errorPos e
|
||||
details = T.strip $ T.replace "\n" " " $ toS
|
||||
$ showErrorMessages "or" "unknown parse error" "expecting" "unexpected" "end of input" (errorMessages e)
|
||||
@@ -3,6 +3,7 @@ module PostgREST.Request.Types
|
||||
( Alias
|
||||
, Depth
|
||||
, EmbedParam(..)
|
||||
, ApiRequestError(..)
|
||||
, EmbedPath
|
||||
, Field
|
||||
, Filter(..)
|
||||
@@ -26,6 +27,7 @@ module PostgREST.Request.Types
|
||||
, OrderDirection(..)
|
||||
, OrderNulls(..)
|
||||
, OrderTerm(..)
|
||||
, QPError(..)
|
||||
, ReadNode
|
||||
, ReadQuery(..)
|
||||
, ReadRequest
|
||||
@@ -33,6 +35,8 @@ module PostgREST.Request.Types
|
||||
, SingleVal
|
||||
, TrileanVal(..)
|
||||
, fstFieldNames
|
||||
, SimpleOperator(..)
|
||||
, FtsOperator(..)
|
||||
) where
|
||||
|
||||
import qualified Data.ByteString.Lazy as LBS
|
||||
@@ -40,9 +44,11 @@ import qualified Data.Set as S
|
||||
|
||||
import Data.Tree (Tree (..))
|
||||
|
||||
import PostgREST.ContentType (ContentType (..))
|
||||
import PostgREST.DbStructure.Identifiers (FieldName,
|
||||
QualifiedIdentifier)
|
||||
import PostgREST.DbStructure.Proc (ProcParam (..))
|
||||
import PostgREST.DbStructure.Proc (ProcDescription (..),
|
||||
ProcParam (..))
|
||||
import PostgREST.DbStructure.Relationship (Relationship)
|
||||
import PostgREST.RangeQuery (NonnegRange)
|
||||
import PostgREST.Request.Preferences (PreferResolution)
|
||||
@@ -50,6 +56,24 @@ import PostgREST.Request.Preferences (PreferResolution)
|
||||
import Protolude
|
||||
|
||||
|
||||
|
||||
data ApiRequestError
|
||||
= ActionInappropriate
|
||||
| InvalidRange
|
||||
| InvalidBody ByteString
|
||||
| ParseRequestError Text Text
|
||||
| QueryParamError QPError
|
||||
| NoRelBetween Text Text Text
|
||||
| AmbiguousRelBetween Text Text [Relationship]
|
||||
| AmbiguousRpc [ProcDescription]
|
||||
| NoRpc Text Text [Text] Bool ContentType Bool
|
||||
| InvalidFilters
|
||||
| UnacceptableSchema [Text]
|
||||
| ContentTypeError [ByteString]
|
||||
| UnsupportedVerb -- Unreachable?
|
||||
|
||||
data QPError = QPError Text Text
|
||||
|
||||
type ReadRequest = Tree ReadNode
|
||||
type MutateRequest = MutateQuery
|
||||
type CallRequest = CallQuery
|
||||
@@ -208,13 +232,12 @@ data OpExpr =
|
||||
deriving (Eq)
|
||||
|
||||
data Operation
|
||||
= Op Operator SingleVal
|
||||
= Op SimpleOperator SingleVal
|
||||
| In ListVal
|
||||
| Is TrileanVal
|
||||
| Fts Operator (Maybe Language) SingleVal
|
||||
| Fts FtsOperator (Maybe Language) SingleVal
|
||||
deriving (Eq)
|
||||
|
||||
type Operator = Text
|
||||
type Language = Text
|
||||
|
||||
-- | Represents a single value in a filter, e.g. id=eq.singleval
|
||||
@@ -230,3 +253,30 @@ data TrileanVal
|
||||
| TriNull
|
||||
| TriUnknown
|
||||
deriving Eq
|
||||
|
||||
data SimpleOperator
|
||||
= OpEqual
|
||||
| OpGreaterThanEqual
|
||||
| OpGreaterThan
|
||||
| OpLessThanEqual
|
||||
| OpLessThan
|
||||
| OpNotEqual
|
||||
| OpLike
|
||||
| OpILike
|
||||
| OpContains
|
||||
| OpContained
|
||||
| OpOverlap
|
||||
| OpStrictlyLeft
|
||||
| OpStrictlyRight
|
||||
| OpNotExtendsRight
|
||||
| OpNotExtendsLeft
|
||||
| OpAdjacent
|
||||
deriving Eq
|
||||
|
||||
-- | Operators for full text search operators
|
||||
data FtsOperator
|
||||
= FilterFts
|
||||
| FilterFtsPlain
|
||||
| FilterFtsPhrase
|
||||
| FilterFtsWebsearch
|
||||
deriving Eq
|
||||
|
||||
@@ -914,7 +914,7 @@ spec actualPgVersion = do
|
||||
{ matchHeaders = [matchContentTypeJson] }
|
||||
|
||||
it "fails if an operator is not given" $
|
||||
get "/ghostBusters?id=0" `shouldRespondWith` [json| {"details":"unexpected \"0\" expecting \"not\" or operator (eq, gt, ...)","message":"\"failed to parse filter (0)\" (line 1, column 1)"} |]
|
||||
get "/ghostBusters?id=0" `shouldRespondWith` [json| {"details":"Failed to parse [(\"id\",\"0\")]","message":"Unexpected param or filter missing operator"} |]
|
||||
{ matchStatus = 400
|
||||
, matchHeaders = [matchContentTypeJson]
|
||||
}
|
||||
|
||||
@@ -8,10 +8,10 @@ import Protolude
|
||||
main :: IO ()
|
||||
main =
|
||||
doctest
|
||||
[ "--verbose"
|
||||
, "-XOverloadedStrings"
|
||||
[ "-XOverloadedStrings"
|
||||
, "-XNoImplicitPrelude"
|
||||
, "-XStandaloneDeriving"
|
||||
, "-isrc"
|
||||
, "src/PostgREST/Request/Preferences.hs"
|
||||
, "src/PostgREST/Request/QueryParams.hs"
|
||||
]
|
||||
|
||||
Reference in New Issue
Block a user