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

refactor: add plan module

Browse Source 
* rename/add plan dirs
* add read plan func/data
* add call plan func/data
* add mutate plan func/data
This commit is contained in:
steve-chavez
2022-10-04 16:13:34 -05:00
committed by Steve Chavez
parent 11385bbd9f
commit 6398dd2b32
10 changed files with 218 additions and 204 deletions
Download Patch File Download Diff File Expand all files Collapse all files
postgrest.cabal
+4 -3
View File
@@ -59,13 +59,14 @@ library
PostgREST.Query.QueryBuilder PostgREST.Query.QueryBuilder
PostgREST.Query.SqlFragment PostgREST.Query.SqlFragment
PostgREST.Query.Statements PostgREST.Query.Statements
PostgREST.Plan
PostgREST.Plan.CallPlan
PostgREST.Plan.MutatePlan
PostgREST.Plan.ReadPlan
PostgREST.RangeQuery PostgREST.RangeQuery
PostgREST.Request.ApiRequest PostgREST.Request.ApiRequest
PostgREST.Request.DbRequestBuilder
PostgREST.Request.MutateQuery
PostgREST.Request.Preferences PostgREST.Request.Preferences
PostgREST.Request.QueryParams PostgREST.Request.QueryParams
PostgREST.Request.ReadQuery
PostgREST.Request.Types PostgREST.Request.Types
PostgREST.Response PostgREST.Response
PostgREST.Response.OpenAPI PostgREST.Response.OpenAPI
src/PostgREST/App.hs
+28 -28
View File
@@ -31,19 +31,18 @@ import qualified Hasql.Transaction.Sessions as SQL
import qualified Network.Wai as Wai import qualified Network.Wai as Wai
import qualified Network.Wai.Handler.Warp as Warp import qualified Network.Wai.Handler.Warp as Warp
import qualified PostgREST.Admin as Admin import qualified PostgREST.Admin as Admin
import qualified PostgREST.AppState as AppState import qualified PostgREST.AppState as AppState
import qualified PostgREST.Auth as Auth import qualified PostgREST.Auth as Auth
import qualified PostgREST.Cors as Cors import qualified PostgREST.Cors as Cors
import qualified PostgREST.Error as Error import qualified PostgREST.Error as Error
import qualified PostgREST.Logger as Logger import qualified PostgREST.Logger as Logger
import qualified PostgREST.Middleware as Middleware import qualified PostgREST.Middleware as Middleware
import qualified PostgREST.Query as Query import qualified PostgREST.Plan as Plan
import qualified PostgREST.Request.ApiRequest as ApiRequest import qualified PostgREST.Query as Query
import qualified PostgREST.Request.DbRequestBuilder as ReqBuilder import qualified PostgREST.Request.ApiRequest as ApiRequest
import qualified PostgREST.Request.MutateQuery as MutateRequest import qualified PostgREST.Request.Types as ApiRequestTypes
import qualified PostgREST.Request.Types as ApiRequestTypes import qualified PostgREST.Response as Response
import qualified PostgREST.Response as Response
import PostgREST.AppState (AppState) import PostgREST.AppState (AppState)
import PostgREST.Auth (AuthResult (..)) import PostgREST.Auth (AuthResult (..))
@@ -57,13 +56,14 @@ import PostgREST.DbStructure.Identifiers (FieldName,
import PostgREST.DbStructure.Proc (ProcDescription (..)) import PostgREST.DbStructure.Proc (ProcDescription (..))
import PostgREST.DbStructure.Table (Table (..)) import PostgREST.DbStructure.Table (Table (..))
import PostgREST.Error (Error) import PostgREST.Error (Error)
import PostgREST.Plan.MutatePlan (MutatePlan)
import PostgREST.Plan.ReadPlan (ReadPlanTree)
import PostgREST.Query (DbHandler) import PostgREST.Query (DbHandler)
import PostgREST.Request.ApiRequest (Action (..), import PostgREST.Request.ApiRequest (Action (..),
ApiRequest (..), ApiRequest (..),
InvokeMethod (..), InvokeMethod (..),
Mutation (..), Target (..)) Mutation (..), Target (..))
import PostgREST.Request.Preferences (PreferRepresentation (..)) import PostgREST.Request.Preferences (PreferRepresentation (..))
import PostgREST.Request.ReadQuery (ReadRequest)
import PostgREST.Version (prettyVersion) import PostgREST.Version (prettyVersion)
import PostgREST.Workers (connectionWorker, listener) import PostgREST.Workers (connectionWorker, listener)
@@ -223,7 +223,7 @@ handleRequest context@(RequestContext _ _ ApiRequest{..} _) =
handleRead :: Bool -> QualifiedIdentifier -> RequestContext -> DbHandler Wai.Response handleRead :: Bool -> QualifiedIdentifier -> RequestContext -> DbHandler Wai.Response
handleRead headersOnly identifier context@RequestContext{..} = do handleRead headersOnly identifier context@RequestContext{..} = do
req <- liftEither $ readRequest identifier context req <- liftEither $ readPlan identifier context
(resultSet, total) <- Query.readQuery req ctxConfig ctxApiRequest (resultSet, total) <- Query.readQuery req ctxConfig ctxApiRequest
@@ -237,7 +237,7 @@ handleCreate identifier context@RequestContext{..} = do
then maybe mempty tablePKCols $ HM.lookup identifier $ dbTables ctxDbStructure then maybe mempty tablePKCols $ HM.lookup identifier $ dbTables ctxDbStructure
else mempty else mempty
(mutateReq, readReq) <- liftEither $ writeRequest MutationCreate identifier context pkCols (mutateReq, readReq) <- liftEither $ mutatePlan MutationCreate identifier context pkCols
resultSet <- Query.createQuery mutateReq readReq pkCols ctxApiRequest ctxConfig resultSet <- Query.createQuery mutateReq readReq pkCols ctxApiRequest ctxConfig
@@ -245,20 +245,20 @@ handleCreate identifier context@RequestContext{..} = do
handleUpdate :: QualifiedIdentifier -> RequestContext -> DbHandler Wai.Response handleUpdate :: QualifiedIdentifier -> RequestContext -> DbHandler Wai.Response
handleUpdate identifier context@(RequestContext ctxConfig _ ctxApiRequest _) = do handleUpdate identifier context@(RequestContext ctxConfig _ ctxApiRequest _) = do
(mutateReq, readReq) <- liftEither $ writeRequest MutationUpdate identifier context mempty (mutateReq, readReq) <- liftEither $ mutatePlan MutationUpdate identifier context mempty
resultSet <- Query.updateQuery mutateReq readReq ctxApiRequest ctxConfig resultSet <- Query.updateQuery mutateReq readReq ctxApiRequest ctxConfig
pure $ Response.updateResponse ctxApiRequest resultSet pure $ Response.updateResponse ctxApiRequest resultSet
handleSingleUpsert :: QualifiedIdentifier -> RequestContext-> DbHandler Wai.Response handleSingleUpsert :: QualifiedIdentifier -> RequestContext-> DbHandler Wai.Response
handleSingleUpsert identifier context@(RequestContext ctxConfig ctxDbStructure ctxApiRequest _) = do handleSingleUpsert identifier context@(RequestContext ctxConfig ctxDbStructure ctxApiRequest _) = do
let pkCols = maybe mempty tablePKCols $ HM.lookup identifier $ dbTables ctxDbStructure let pkCols = maybe mempty tablePKCols $ HM.lookup identifier $ dbTables ctxDbStructure
(mutateReq, readReq) <- liftEither $ writeRequest MutationSingleUpsert identifier context pkCols (mutateReq, readReq) <- liftEither $ mutatePlan MutationSingleUpsert identifier context pkCols
resultSet <- Query.singleUpsertQuery mutateReq readReq ctxApiRequest ctxConfig resultSet <- Query.singleUpsertQuery mutateReq readReq ctxApiRequest ctxConfig
pure $ Response.singleUpsertResponse ctxApiRequest resultSet pure $ Response.singleUpsertResponse ctxApiRequest resultSet
handleDelete :: QualifiedIdentifier -> RequestContext -> DbHandler Wai.Response handleDelete :: QualifiedIdentifier -> RequestContext -> DbHandler Wai.Response
handleDelete identifier context@(RequestContext ctxConfig _ ctxApiRequest _) = do handleDelete identifier context@(RequestContext ctxConfig _ ctxApiRequest _) = do
(mutateReq, readReq) <- liftEither $ writeRequest MutationDelete identifier context mempty (mutateReq, readReq) <- liftEither $ mutatePlan MutationDelete identifier context mempty
resultSet <- Query.deleteQuery mutateReq readReq ctxApiRequest ctxConfig resultSet <- Query.deleteQuery mutateReq readReq ctxApiRequest ctxConfig
pure $ Response.deleteResponse ctxApiRequest resultSet pure $ Response.deleteResponse ctxApiRequest resultSet
@@ -270,8 +270,8 @@ handleInvoke invMethod proc context@RequestContext{..} = do
(pdSchema proc) (pdSchema proc)
(fromMaybe (pdName proc) $ Proc.procTableName proc) (fromMaybe (pdName proc) $ Proc.procTableName proc)
readReq <- liftEither $ readRequest identifier context readReq <- liftEither $ readPlan identifier context
let callReq = ReqBuilder.callRequest proc ctxApiRequest readReq let callReq = Plan.callPlan proc ctxApiRequest readReq
resultSet <- Query.invokeQuery proc callReq readReq ctxApiRequest ctxConfig resultSet <- Query.invokeQuery proc callReq readReq ctxApiRequest ctxConfig
@@ -282,14 +282,14 @@ handleOpenApi headersOnly tSchema (RequestContext conf dbStructure apiRequest pg
oaiResult <- Query.openApiQuery dbStructure pgVer conf tSchema oaiResult <- Query.openApiQuery dbStructure pgVer conf tSchema
pure $ Response.openApiResponse headersOnly oaiResult conf dbStructure (iSchema apiRequest) (iNegotiatedByProfile apiRequest) pure $ Response.openApiResponse headersOnly oaiResult conf dbStructure (iSchema apiRequest) (iNegotiatedByProfile apiRequest)
writeRequest :: Mutation -> QualifiedIdentifier -> RequestContext -> [FieldName] -> Either Error (MutateRequest.MutateRequest, ReadRequest) mutatePlan :: Mutation -> QualifiedIdentifier -> RequestContext -> [FieldName] -> Either Error (MutatePlan, ReadPlanTree)
writeRequest mutation identifier@QualifiedIdentifier{..} context@RequestContext{..} pkCols = do mutatePlan mutation identifier@QualifiedIdentifier{..} context@RequestContext{..} pkCols = do
readReq <- readRequest identifier context readReq <- readPlan identifier context
mutateReq <- ReqBuilder.mutateRequest mutation qiSchema qiName ctxApiRequest pkCols readReq mutateReq <- Plan.mutatePlan mutation qiSchema qiName ctxApiRequest pkCols readReq
pure (mutateReq, readReq) pure (mutateReq, readReq)
readRequest :: QualifiedIdentifier -> RequestContext -> Either Error ReadRequest readPlan :: QualifiedIdentifier -> RequestContext -> Either Error ReadPlanTree
readRequest QualifiedIdentifier{..} (RequestContext AppConfig{..} dbStructure apiRequest _) = readPlan QualifiedIdentifier{..} (RequestContext AppConfig{..} dbStructure apiRequest _) =
ReqBuilder.readRequest qiSchema qiName configDbMaxRows Plan.readPlan qiSchema qiName configDbMaxRows
(dbRelationships dbStructure) (dbRelationships dbStructure)
apiRequest apiRequest
src/PostgREST/Request/DbRequestBuilder.hs → src/PostgREST/Plan.hs
+78 -70
View File
@@ -1,9 +1,9 @@
{-| {-|
Module : PostgREST.Request.DbRequestBuilder Module : PostgREST.Plan
Description : PostgREST database request builder Description : PostgREST Request Planner
This module is in charge of building an intermediate This module is in charge of building an intermediate
representation(ReadRequest, MutateRequest) between the HTTP request and the representation between the HTTP request and the
final resulting SQL query. final resulting SQL query.
A query tree is built in case of resource embedding. By inferring the A query tree is built in case of resource embedding. By inferring the
@@ -15,10 +15,10 @@ resource.
{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE RecordWildCards #-}
module PostgREST.Request.DbRequestBuilder module PostgREST.Plan
( readRequest ( readPlan
, mutateRequest , mutatePlan
, callRequest , callPlan
) where ) where
import qualified Data.HashMap.Strict as HM import qualified Data.HashMap.Strict as HM
@@ -48,20 +48,21 @@ import PostgREST.Request.ApiRequest (Action (..),
Mutation (..), Mutation (..),
Payload (..)) Payload (..))
import PostgREST.Request.MutateQuery import PostgREST.Plan.CallPlan
import PostgREST.Plan.MutatePlan
import PostgREST.Plan.ReadPlan as ReadPlan
import PostgREST.Request.Preferences import PostgREST.Request.Preferences
import PostgREST.Request.ReadQuery as ReadQuery
import PostgREST.Request.Types import PostgREST.Request.Types
import qualified PostgREST.Request.QueryParams as QueryParams import qualified PostgREST.Request.QueryParams as QueryParams
import Protolude hiding (from) import Protolude hiding (from)
-- | Builds the ReadRequest tree on a number of stages. -- | Builds the ReadPlan tree on a number of stages.
-- | Adds filters, order, limits on its respective nodes. -- | Adds filters, order, limits on its respective nodes.
-- | Adds joins conditions obtained from resource embedding. -- | Adds joins conditions obtained from resource embedding.
readRequest :: Schema -> TableName -> Maybe Integer -> RelationshipsMap -> ApiRequest -> Either Error ReadRequest readPlan :: Schema -> TableName -> Maybe Integer -> RelationshipsMap -> ApiRequest -> Either Error ReadPlanTree
readRequest schema rootTableName maxRows allRels apiRequest = readPlan schema rootTableName maxRows allRels apiRequest =
mapLeft ApiRequestError $ mapLeft ApiRequestError $
treeRestrictRange maxRows (iAction apiRequest) =<< treeRestrictRange maxRows (iAction apiRequest) =<<
augmentRequestWithJoin schema allRels =<< augmentRequestWithJoin schema allRels =<<
@@ -80,67 +81,67 @@ readRequest schema rootTableName maxRows allRels apiRequest =
-- can differentiate the parent and child tables by having an alias like -- can differentiate the parent and child tables by having an alias like
-- "table_depth", this is related to -- "table_depth", this is related to
-- http://github.com/PostgREST/postgrest/issues/987. -- http://github.com/PostgREST/postgrest/issues/987.
initReadRequest :: QualifiedIdentifier -> Maybe Alias -> [Tree SelectItem] -> ReadRequest initReadRequest :: QualifiedIdentifier -> Maybe Alias -> [Tree SelectItem] -> ReadPlanTree
initReadRequest rootQi rootAlias = initReadRequest rootQi rootAlias =
foldr (treeEntry rootDepth) initial foldr (treeEntry rootDepth) initial
where where
rootDepth = 0 rootDepth = 0
rootSchema = qiSchema rootQi rootSchema = qiSchema rootQi
rootName = qiName rootQi rootName = qiName rootQi
initial = Node (Select [] rootQi rootAlias [] [] [] allRange, (rootName, Nothing, Nothing, Nothing, Nothing, rootDepth)) [] initial = Node (ReadPlan [] rootQi rootAlias [] [] [] allRange rootName Nothing Nothing Nothing Nothing rootDepth) []
treeEntry :: Depth -> Tree SelectItem -> ReadRequest -> ReadRequest treeEntry :: Depth -> Tree SelectItem -> ReadPlanTree -> ReadPlanTree
treeEntry depth (Node fld@((fn, _),_,alias, hint, joinType) fldForest) (Node (q, i) rForest) = treeEntry depth (Node fld@((fn, _),_,alias, hint, joinType) fldForest) (Node q rForest) =
let nxtDepth = succ depth in let nxtDepth = succ depth in
case fldForest of case fldForest of
[] -> Node (q {select=fld:select q}, i) rForest [] -> Node q{select=fld:select q} rForest
_ -> Node (q, i) $ _ -> Node q $
foldr (treeEntry nxtDepth) foldr (treeEntry nxtDepth)
(Node (Select [] (QualifiedIdentifier rootSchema fn) Nothing [] [] [] allRange, (Node (ReadPlan [] (QualifiedIdentifier rootSchema fn) Nothing [] [] [] allRange fn Nothing alias hint joinType nxtDepth) [])
(fn, Nothing, alias, hint, joinType, nxtDepth)) [])
fldForest:rForest fldForest:rForest
-- | Enforces the `max-rows` config on the result -- | Enforces the `max-rows` config on the result
treeRestrictRange :: Maybe Integer -> Action -> ReadRequest -> Either ApiRequestError ReadRequest treeRestrictRange :: Maybe Integer -> Action -> ReadPlanTree -> Either ApiRequestError ReadPlanTree
treeRestrictRange _ (ActionMutate _) request = Right request treeRestrictRange _ (ActionMutate _) request = Right request
treeRestrictRange maxRows _ request = pure $ nodeRestrictRange maxRows <$> request treeRestrictRange maxRows _ request = pure $ nodeRestrictRange maxRows <$> request
where where
nodeRestrictRange :: Maybe Integer -> ReadNode -> ReadNode nodeRestrictRange :: Maybe Integer -> ReadPlan -> ReadPlan
nodeRestrictRange m (q@Select {range_=r}, i) = (q{range_=restrictRange m r }, i) nodeRestrictRange m q@ReadPlan{range_=r} = q{range_=restrictRange m r }
augmentRequestWithJoin :: Schema -> RelationshipsMap -> ReadRequest -> Either ApiRequestError ReadRequest augmentRequestWithJoin :: Schema -> RelationshipsMap -> ReadPlanTree -> Either ApiRequestError ReadPlanTree
augmentRequestWithJoin schema allRels request = augmentRequestWithJoin schema allRels request =
addJoinConditions Nothing <$> addRels schema allRels Nothing request addJoinConditions Nothing <$> addRels schema allRels Nothing request
addRels :: Schema -> RelationshipsMap -> Maybe ReadRequest -> ReadRequest -> Either ApiRequestError ReadRequest addRels :: Schema -> RelationshipsMap -> Maybe ReadPlanTree -> ReadPlanTree -> Either ApiRequestError ReadPlanTree
addRels schema allRels parentNode (Node (query@Select{from=tbl}, (nodeName, _, alias, hint, joinType, depth)) forest) = addRels schema allRels parentNode (Node query@ReadPlan{from=tbl,nodeName,nodeHint,nodeDepth} forest) =
case parentNode of case parentNode of
Just (Node (Select{from=parentNodeQi, fromAlias=aliasQi}, _) _) -> Just (Node ReadPlan{from=parentNodeQi, fromAlias=aliasQi} _) ->
let newFrom r = if qiName tbl == nodeName then relForeignTable r else tbl let newFrom r = if qiName tbl == nodeName then relForeignTable r else tbl
newReadNode = (\r -> newReadPlan = (\r ->
if not $ relIsSelf r -- add alias if self rel TODO consolidate aliasing in another function if not $ relIsSelf r -- add alias if self rel TODO consolidate aliasing in another function
then (query{from=newFrom r}, (nodeName, Just r, alias, hint, joinType, depth)) then query{from=newFrom r, nodeRel=Just r}
else (query{from=newFrom r, fromAlias=Just (qiName (newFrom r) <> "_" <> show depth)}, (nodeName, Just r, alias, hint, joinType, depth)) else query{from=newFrom r, nodeRel=Just r, fromAlias=Just (qiName (newFrom r) <> "_" <> show nodeDepth)}
) <$> rel ) <$> rel
origin = if depth == 1 -- Only on depth 1 we check if the root(depth 0) has an alias so the sourceCTEName alias can be found as a relationship origin = if nodeDepth == 1 -- Only on depth 1 we check if the root(depth 0) has an alias so the sourceCTEName alias can be found as a relationship
then fromMaybe (qiName parentNodeQi) aliasQi then fromMaybe (qiName parentNodeQi) aliasQi
else qiName parentNodeQi else qiName parentNodeQi
rel = findRel schema allRels origin nodeName hint rel = findRel schema allRels origin nodeName nodeHint
in in
Node <$> newReadNode <*> (updateForest . hush $ Node <$> newReadNode <*> pure forest) Node <$> newReadPlan <*> (updateForest . hush $ Node <$> newReadPlan <*> pure forest)
_ -> _ ->
let rn = (query, (nodeName, Nothing, alias, Nothing, joinType, depth)) in Node query <$> updateForest (Just $ Node query forest)
Node rn <$> updateForest (Just $ Node rn forest)
where where
updateForest :: Maybe ReadRequest -> Either ApiRequestError [ReadRequest] updateForest :: Maybe ReadPlanTree -> Either ApiRequestError [ReadPlanTree]
updateForest rq = addRels schema allRels rq `traverse` forest updateForest rq = addRels schema allRels rq `traverse` forest
-- applies aliasing to join conditions TODO refactor, this should go into the querybuilder module -- applies aliasing to join conditions TODO refactor, this should go into the querybuilder module
addJoinConditions :: Maybe Alias -> ReadRequest -> ReadRequest addJoinConditions :: Maybe Alias -> ReadPlanTree -> ReadPlanTree
addJoinConditions _ (Node node@(Select{fromAlias=tblAlias}, (_, Nothing, _, _, _, _)) forest) = Node node (addJoinConditions tblAlias <$> forest) addJoinConditions _ (Node node@ReadPlan{fromAlias=tblAlias, nodeRel=Nothing} forest) = Node node (addJoinConditions tblAlias <$> forest)
addJoinConditions _ (Node node@(Select{fromAlias=tblAlias}, (_, Just ComputedRelationship{}, _, _, _, _)) forest) = Node node (addJoinConditions tblAlias <$> forest) addJoinConditions _ (Node node@ReadPlan{fromAlias=tblAlias, nodeRel=Just ComputedRelationship{}} forest) = Node node (addJoinConditions tblAlias <$> forest)
addJoinConditions previousAlias (Node (query@Select{fromAlias=tblAlias}, nodeProps@(_, Just (Relationship QualifiedIdentifier{qiSchema=tSchema, qiName=tN} QualifiedIdentifier{qiName=ftN} _ card _ _), _, _, _, _)) forest) = addJoinConditions previousAlias (Node query@ReadPlan{fromAlias=tblAlias, nodeRel=Just Relationship{relTable=qi,relForeignTable=fQi,relCardinality=card}} forest) =
Node (query{joinConditions=joinConds}, nodeProps) (addJoinConditions tblAlias <$> forest) Node query{joinConditions=joinConds} (addJoinConditions tblAlias <$> forest)
where where
QualifiedIdentifier{qiSchema=tSchema, qiName=tN} = qi
QualifiedIdentifier{qiName=ftN} = fQi
joinConds = joinConds =
case card of case card of
M2M (Junction QualifiedIdentifier{qiName=jtn} _ _ jcols1 jcols2) -> M2M (Junction QualifiedIdentifier{qiName=jtn} _ _ jcols1 jcols2) ->
@@ -241,7 +242,7 @@ findRel schema allRels origin target hint =
) )
) $ fromMaybe mempty $ HM.lookup (QualifiedIdentifier schema origin, schema) allRels ) $ fromMaybe mempty $ HM.lookup (QualifiedIdentifier schema origin, schema) allRels
addFilters :: ApiRequest -> ReadRequest -> Either ApiRequestError ReadRequest addFilters :: ApiRequest -> ReadPlanTree -> Either ApiRequestError ReadPlanTree
addFilters ApiRequest{..} rReq = addFilters ApiRequest{..} rReq =
foldr addFilterToNode (Right rReq) flts foldr addFilterToNode (Right rReq) flts
where where
@@ -254,11 +255,11 @@ addFilters ApiRequest{..} rReq =
ActionRead _ -> qsFilters ActionRead _ -> qsFilters
_ -> qsFiltersNotRoot _ -> qsFiltersNotRoot
addFilterToNode :: (EmbedPath, Filter) -> Either ApiRequestError ReadRequest -> Either ApiRequestError ReadRequest addFilterToNode :: (EmbedPath, Filter) -> Either ApiRequestError ReadPlanTree -> Either ApiRequestError ReadPlanTree
addFilterToNode = addFilterToNode =
updateNode (\flt (Node (q@Select {where_=lf}, i) f) -> Node (q{ReadQuery.where_=addFilterToLogicForest flt lf}, i) f) updateNode (\flt (Node q@ReadPlan{where_=lf} f) -> Node q{ReadPlan.where_=addFilterToLogicForest flt lf} f)
addOrders :: ApiRequest -> ReadRequest -> Either ApiRequestError ReadRequest addOrders :: ApiRequest -> ReadPlanTree -> Either ApiRequestError ReadPlanTree
addOrders ApiRequest{..} rReq = addOrders ApiRequest{..} rReq =
case iAction of case iAction of
ActionMutate _ -> Right rReq ActionMutate _ -> Right rReq
@@ -266,10 +267,10 @@ addOrders ApiRequest{..} rReq =
where where
QueryParams.QueryParams{..} = iQueryParams QueryParams.QueryParams{..} = iQueryParams
addOrderToNode :: (EmbedPath, [OrderTerm]) -> Either ApiRequestError ReadRequest -> Either ApiRequestError ReadRequest addOrderToNode :: (EmbedPath, [OrderTerm]) -> Either ApiRequestError ReadPlanTree -> Either ApiRequestError ReadPlanTree
addOrderToNode = updateNode (\o (Node (q,i) f) -> Node (q{order=o}, i) f) addOrderToNode = updateNode (\o (Node q f) -> Node q{order=o} f)
addRanges :: ApiRequest -> ReadRequest -> Either ApiRequestError ReadRequest addRanges :: ApiRequest -> ReadPlanTree -> Either ApiRequestError ReadPlanTree
addRanges ApiRequest{..} rReq = addRanges ApiRequest{..} rReq =
case iAction of case iAction of
ActionMutate _ -> Right rReq ActionMutate _ -> Right rReq
@@ -278,20 +279,20 @@ addRanges ApiRequest{..} rReq =
ranges :: Either ApiRequestError [(EmbedPath, NonnegRange)] ranges :: Either ApiRequestError [(EmbedPath, NonnegRange)]
ranges = first QueryParamError $ QueryParams.pRequestRange `traverse` HM.toList iRange ranges = first QueryParamError $ QueryParams.pRequestRange `traverse` HM.toList iRange
addRangeToNode :: (EmbedPath, NonnegRange) -> Either ApiRequestError ReadRequest -> Either ApiRequestError ReadRequest addRangeToNode :: (EmbedPath, NonnegRange) -> Either ApiRequestError ReadPlanTree -> Either ApiRequestError ReadPlanTree
addRangeToNode = updateNode (\r (Node (q,i) f) -> Node (q{range_=r}, i) f) addRangeToNode = updateNode (\r (Node q f) -> Node q{range_=r} f)
addLogicTrees :: ApiRequest -> ReadRequest -> Either ApiRequestError ReadRequest addLogicTrees :: ApiRequest -> ReadPlanTree -> Either ApiRequestError ReadPlanTree
addLogicTrees ApiRequest{..} rReq = addLogicTrees ApiRequest{..} rReq =
foldr addLogicTreeToNode (Right rReq) qsLogic foldr addLogicTreeToNode (Right rReq) qsLogic
where where
QueryParams.QueryParams{..} = iQueryParams QueryParams.QueryParams{..} = iQueryParams
addLogicTreeToNode :: (EmbedPath, LogicTree) -> Either ApiRequestError ReadRequest -> Either ApiRequestError ReadRequest addLogicTreeToNode :: (EmbedPath, LogicTree) -> Either ApiRequestError ReadPlanTree -> Either ApiRequestError ReadPlanTree
addLogicTreeToNode = updateNode (\t (Node (q@Select{where_=lf},i) f) -> Node (q{ReadQuery.where_=t:lf}, i) f) addLogicTreeToNode = updateNode (\t (Node q@ReadPlan{where_=lf} f) -> Node q{ReadPlan.where_=t:lf} f)
-- Find a Node of the Tree and apply a function to it -- Find a Node of the Tree and apply a function to it
updateNode :: (a -> ReadRequest -> ReadRequest) -> (EmbedPath, a) -> Either ApiRequestError ReadRequest -> Either ApiRequestError ReadRequest updateNode :: (a -> ReadPlanTree -> ReadPlanTree) -> (EmbedPath, a) -> Either ApiRequestError ReadPlanTree -> Either ApiRequestError ReadPlanTree
updateNode f ([], a) rr = f a <$> rr updateNode f ([], a) rr = f a <$> rr
updateNode _ _ (Left e) = Left e updateNode _ _ (Left e) = Left e
updateNode f (targetNodeName:remainingPath, a) (Right (Node rootNode forest)) = updateNode f (targetNodeName:remainingPath, a) (Right (Node rootNode forest)) =
@@ -301,11 +302,11 @@ updateNode f (targetNodeName:remainingPath, a) (Right (Node rootNode forest)) =
(\node -> Node rootNode $ node : delete target forest) <$> (\node -> Node rootNode $ node : delete target forest) <$>
updateNode f (remainingPath, a) (Right target) updateNode f (remainingPath, a) (Right target)
where where
findNode :: Maybe ReadRequest findNode :: Maybe ReadPlanTree
findNode = find (\(Node (_,(nodeName,_,alias,_,_, _)) _) -> nodeName == targetNodeName || alias == Just targetNodeName) forest findNode = find (\(Node ReadPlan{nodeName, nodeAlias} _) -> nodeName == targetNodeName || nodeAlias == Just targetNodeName) forest
mutateRequest :: Mutation -> Schema -> TableName -> ApiRequest -> [FieldName] -> ReadRequest -> Either Error MutateRequest mutatePlan :: Mutation -> Schema -> TableName -> ApiRequest -> [FieldName] -> ReadPlanTree -> Either Error MutatePlan
mutateRequest mutation schema tName ApiRequest{..} pkCols readReq = mapLeft ApiRequestError $ mutatePlan mutation schema tName ApiRequest{..} pkCols readReq = mapLeft ApiRequestError $
case mutation of case mutation of
MutationCreate -> MutationCreate ->
Right $ Insert qi iColumns body ((,) <$> iPreferResolution <*> Just confCols) [] returnings Right $ Insert qi iColumns body ((,) <$> iPreferResolution <*> Just confCols) [] returnings
@@ -334,8 +335,8 @@ mutateRequest mutation schema tName ApiRequest{..} pkCols readReq = mapLeft ApiR
combinedLogic = foldr addFilterToLogicForest logic qsFiltersRoot combinedLogic = foldr addFilterToLogicForest logic qsFiltersRoot
body = payRaw <$> iPayload -- the body is assumed to be json at this stage(ApiRequest validates) body = payRaw <$> iPayload -- the body is assumed to be json at this stage(ApiRequest validates)
callRequest :: ProcDescription -> ApiRequest -> ReadRequest -> CallRequest callPlan :: ProcDescription -> ApiRequest -> ReadPlanTree -> CallPlan
callRequest proc apiReq readReq = FunctionCall { callPlan proc apiReq readReq = FunctionCall {
funCQi = QualifiedIdentifier (pdSchema proc) (pdName proc) funCQi = QualifiedIdentifier (pdSchema proc) (pdName proc)
, funCParams = callParams , funCParams = callParams
, funCArgs = payRaw <$> iPayload apiReq , funCArgs = payRaw <$> iPayload apiReq
@@ -352,7 +353,7 @@ callRequest proc apiReq readReq = FunctionCall {
prms -> KeyParams $ specifiedParams prms prms -> KeyParams $ specifiedParams prms
specifiedParams = filter (\x -> ppName x `S.member` iColumns apiReq) specifiedParams = filter (\x -> ppName x `S.member` iColumns apiReq)
returningCols :: ReadRequest -> [FieldName] -> [FieldName] returningCols :: ReadPlanTree -> [FieldName] -> [FieldName]
returningCols rr@(Node _ forest) pkCols returningCols rr@(Node _ forest) pkCols
-- if * is part of the select, we must not add pk or fk columns manually - -- if * is part of the select, we must not add pk or fk columns manually -
-- otherwise those would be selected and output twice -- otherwise those would be selected and output twice
@@ -360,24 +361,31 @@ returningCols rr@(Node _ forest) pkCols
| otherwise = returnings | otherwise = returnings
where where
fldNames = fstFieldNames rr fldNames = fstFieldNames rr
-- Without fkCols, when a mutateRequest to -- Without fkCols, when a mutatePlan to
-- /projects?select=name,clients(name) occurs, the RETURNING SQL part would -- /projects?select=name,clients(name) occurs, the RETURNING SQL part would
-- be `RETURNING name`(see QueryBuilder). This would make the embedding -- be `RETURNING name`(see QueryBuilder). This would make the embedding
-- fail because the following JOIN would need the "client_id" column from -- fail because the following JOIN would need the "client_id" column from
-- projects. So this adds the foreign key columns to ensure the embedding -- projects. So this adds the foreign key columns to ensure the embedding
-- succeeds, result would be `RETURNING name, client_id`. -- succeeds, result would be `RETURNING name, client_id`.
fkCols = concat $ mapMaybe (\case fkCols = concat $ mapMaybe (\case
Node (_, (_, Just Relationship{relCardinality=O2M _ cols}, _, _, _, _)) _ -> Just $ fst <$> cols Node ReadPlan{nodeRel=Just Relationship{relCardinality=O2M _ cols}} _ ->
Node (_, (_, Just Relationship{relCardinality=M2O _ cols}, _, _, _, _)) _ -> Just $ fst <$> cols Just $ fst <$> cols
Node (_, (_, Just Relationship{relCardinality=O2O _ cols}, _, _, _, _)) _ -> Just $ fst <$> cols Node ReadPlan{nodeRel=Just Relationship{relCardinality=M2O _ cols}} _ ->
Node (_, (_, Just Relationship{relCardinality=M2M Junction{junColumns1, junColumns2}}, _, _, _, _)) _ -> Just $ (fst <$> junColumns1) ++ (fst <$> junColumns2) Just $ fst <$> cols
_ -> Nothing Node ReadPlan{nodeRel=Just Relationship{relCardinality=O2O _ cols}} _ ->
Just $ fst <$> cols
Node ReadPlan{nodeRel=Just Relationship{relCardinality=M2M Junction{junColumns1, junColumns2}}} _ ->
Just $ (fst <$> junColumns1) ++ (fst <$> junColumns2)
Node ReadPlan{nodeRel=Just ComputedRelationship{}} _ ->
Nothing
Node ReadPlan{nodeRel=Nothing} _ ->
Nothing
) forest ) forest
hasComputedRel = isJust $ find (\case hasComputedRel = isJust $ find (\case
Node (_, (_, Just ComputedRelationship{}, _, _, _, _)) _ -> True Node ReadPlan{nodeRel=Just ComputedRelationship{}} _ -> True
_ -> False _ -> False
) forest ) forest
-- However if the "client_id" is present, e.g. mutateRequest to -- However if the "client_id" is present, e.g. mutatePlan to
-- /projects?select=client_id,name,clients(name) we would get `RETURNING -- /projects?select=client_id,name,clients(name) we would get `RETURNING
-- client_id, name, client_id` and then we would produce the "column -- client_id, name, client_id` and then we would produce the "column
-- reference \"client_id\" is ambiguous" error from PostgreSQL. So we -- reference \"client_id\" is ambiguous" error from PostgreSQL. So we
src/PostgREST/Plan/CallPlan.hs
+25
View File
@@ -0,0 +1,25 @@
module PostgREST.Plan.CallPlan
( CallPlan(..)
, CallParams(..)
)
where
import qualified Data.ByteString.Lazy as LBS
import PostgREST.DbStructure.Identifiers (FieldName,
QualifiedIdentifier)
import PostgREST.DbStructure.Proc (ProcParam (..))
import Protolude
data CallPlan = FunctionCall
{ funCQi :: QualifiedIdentifier
, funCParams :: CallParams
, funCArgs :: Maybe LBS.ByteString
, funCScalar :: Bool
, funCMultipleCall :: Bool
, funCReturning :: [FieldName]
}
data CallParams
= KeyParams [ProcParam] -- ^ Call with key params: func(a := val1, b:= val2)
| OnePosParam ProcParam -- ^ Call with positional params(only one supported): func(val)
src/PostgREST/Request/MutateQuery.hs → src/PostgREST/Plan/MutatePlan.hs
+3 -6
View File
@@ -1,6 +1,5 @@
module PostgREST.Request.MutateQuery module PostgREST.Plan.MutatePlan
( MutateQuery(..) ( MutatePlan(..)
, MutateRequest
) )
where where
@@ -15,9 +14,7 @@ import PostgREST.Request.Types (LogicTree, OrderTerm)
import Protolude import Protolude
type MutateRequest = MutateQuery data MutatePlan
data MutateQuery
= Insert = Insert
{ in_ :: QualifiedIdentifier { in_ :: QualifiedIdentifier
, insCols :: S.Set FieldName , insCols :: S.Set FieldName
src/PostgREST/Request/ReadQuery.hs → src/PostgREST/Plan/ReadPlan.hs
+15 -12
View File
@@ -1,7 +1,7 @@
module PostgREST.Request.ReadQuery {-# LANGUAGE NamedFieldPuns #-}
( ReadNode module PostgREST.Plan.ReadPlan
, ReadQuery(..) ( ReadPlanTree
, ReadRequest , ReadPlan(..)
, fstFieldNames , fstFieldNames
) where ) where
@@ -19,12 +19,9 @@ import PostgREST.Request.Types (Alias, Depth, Hint,
import Protolude import Protolude
type ReadRequest = Tree ReadNode type ReadPlanTree = Tree ReadPlan
type ReadNode = data ReadPlan = ReadPlan
(ReadQuery, (NodeName, Maybe Relationship, Maybe Alias, Maybe Hint, Maybe JoinType, Depth))
data ReadQuery = Select
{ select :: [SelectItem] { select :: [SelectItem]
, from :: QualifiedIdentifier , from :: QualifiedIdentifier
, fromAlias :: Maybe Alias , fromAlias :: Maybe Alias
@@ -33,10 +30,16 @@ data ReadQuery = Select
, joinConditions :: [JoinCondition] , joinConditions :: [JoinCondition]
, order :: [OrderTerm] , order :: [OrderTerm]
, range_ :: NonnegRange , range_ :: NonnegRange
, nodeName :: NodeName
, nodeRel :: Maybe Relationship
, nodeAlias :: Maybe Alias
, nodeHint :: Maybe Hint
, nodeJoinType :: Maybe JoinType
, nodeDepth :: Depth
} }
deriving (Eq) deriving (Eq)
-- First level FieldNames(e.g get a,b from /table?select=a,b,other(c,d)) -- First level FieldNames(e.g get a,b from /table?select=a,b,other(c,d))
fstFieldNames :: ReadRequest -> [FieldName] fstFieldNames :: ReadPlanTree -> [FieldName]
fstFieldNames (Node (sel, _) _) = fstFieldNames (Node ReadPlan{select} _) =
fst . (\(f, _, _, _, _) -> f) <$> select sel fst . (\(f, _, _, _, _) -> f) <$> select
src/PostgREST/Query.hs
+23 -23
View File
@@ -24,14 +24,12 @@ import qualified Hasql.DynamicStatements.Statement as SQL
import qualified Hasql.Transaction as SQL import qualified Hasql.Transaction as SQL
import qualified Hasql.Transaction.Sessions as SQL import qualified Hasql.Transaction.Sessions as SQL
import qualified PostgREST.DbStructure as DbStructure import qualified PostgREST.DbStructure as DbStructure
import qualified PostgREST.DbStructure.Proc as Proc import qualified PostgREST.DbStructure.Proc as Proc
import qualified PostgREST.Error as Error import qualified PostgREST.Error as Error
import qualified PostgREST.Query.QueryBuilder as QueryBuilder import qualified PostgREST.Query.QueryBuilder as QueryBuilder
import qualified PostgREST.Query.Statements as Statements import qualified PostgREST.Query.Statements as Statements
import qualified PostgREST.RangeQuery as RangeQuery import qualified PostgREST.RangeQuery as RangeQuery
import qualified PostgREST.Request.MutateQuery as MutateRequest
import qualified PostgREST.Request.Types as ApiRequestTypes
import Data.Scientific (FPFormat (..), formatScientific, isInteger) import Data.Scientific (FPFormat (..), formatScientific, isInteger)
@@ -49,6 +47,9 @@ import PostgREST.DbStructure.Proc (ProcDescription (..),
import PostgREST.DbStructure.Table (TablesMap) import PostgREST.DbStructure.Table (TablesMap)
import PostgREST.Error (Error) import PostgREST.Error (Error)
import PostgREST.MediaType (MediaType (..)) import PostgREST.MediaType (MediaType (..))
import PostgREST.Plan.CallPlan (CallPlan)
import PostgREST.Plan.MutatePlan (MutatePlan)
import PostgREST.Plan.ReadPlan (ReadPlanTree)
import PostgREST.Query.SqlFragment (fromQi, intercalateSnippet, import PostgREST.Query.SqlFragment (fromQi, intercalateSnippet,
pgFmtIdentList, pgFmtIdentList,
setConfigLocal, setConfigLocal,
@@ -61,19 +62,18 @@ import PostgREST.Request.ApiRequest (Action (..),
import PostgREST.Request.Preferences (PreferCount (..), import PostgREST.Request.Preferences (PreferCount (..),
PreferParameters (..), PreferParameters (..),
shouldCount) shouldCount)
import PostgREST.Request.ReadQuery (ReadRequest)
import Protolude hiding (Handler) import Protolude hiding (Handler)
type DbHandler = ExceptT Error SQL.Transaction type DbHandler = ExceptT Error SQL.Transaction
readQuery :: ReadRequest -> AppConfig -> ApiRequest -> DbHandler (ResultSet, Maybe Int64) readQuery :: ReadPlanTree -> AppConfig -> ApiRequest -> DbHandler (ResultSet, Maybe Int64)
readQuery req conf@AppConfig{..} apiReq@ApiRequest{..} = do readQuery req conf@AppConfig{..} apiReq@ApiRequest{..} = do
let countQuery = QueryBuilder.readRequestToCountQuery req let countQuery = QueryBuilder.readPlanToCountQuery req
resultSet <- resultSet <-
lift . SQL.statement mempty $ lift . SQL.statement mempty $
Statements.prepareRead Statements.prepareRead
(QueryBuilder.readRequestToQuery req) (QueryBuilder.readPlanToQuery req)
(if iPreferCount == Just EstimatedCount then (if iPreferCount == Just EstimatedCount then
-- LIMIT maxRows + 1 so we can determine below that maxRows was surpassed -- LIMIT maxRows + 1 so we can determine below that maxRows was surpassed
QueryBuilder.limitedQuery countQuery ((+ 1) <$> configDbMaxRows) QueryBuilder.limitedQuery countQuery ((+ 1) <$> configDbMaxRows)
@@ -106,20 +106,20 @@ readTotal AppConfig{..} ApiRequest{..} RSStandard{rsTableTotal=tableTotal} count
lift . SQL.statement mempty . Statements.preparePlanRows countQuery $ lift . SQL.statement mempty . Statements.preparePlanRows countQuery $
configDbPreparedStatements configDbPreparedStatements
createQuery :: MutateRequest.MutateRequest -> ReadRequest -> [FieldName] -> ApiRequest -> AppConfig -> DbHandler ResultSet createQuery :: MutatePlan -> ReadPlanTree -> [FieldName] -> ApiRequest -> AppConfig -> DbHandler ResultSet
createQuery mutateReq readReq pkCols apiReq@ApiRequest{..} conf = do createQuery mutateReq readReq pkCols apiReq@ApiRequest{..} conf = do
resultSet <- writeQuery mutateReq readReq True pkCols apiReq conf resultSet <- writeQuery mutateReq readReq True pkCols apiReq conf
failNotSingular iAcceptMediaType resultSet failNotSingular iAcceptMediaType resultSet
pure resultSet pure resultSet
updateQuery :: MutateRequest.MutateRequest -> ReadRequest -> ApiRequest -> AppConfig -> DbHandler ResultSet updateQuery :: MutatePlan -> ReadPlanTree -> ApiRequest -> AppConfig -> DbHandler ResultSet
updateQuery mutateReq readReq apiReq@ApiRequest{..} conf = do updateQuery mutateReq readReq apiReq@ApiRequest{..} conf = do
resultSet <- writeQuery mutateReq readReq False mempty apiReq conf resultSet <- writeQuery mutateReq readReq False mempty apiReq conf
failNotSingular iAcceptMediaType resultSet failNotSingular iAcceptMediaType resultSet
failsChangesOffLimits (RangeQuery.rangeLimit iTopLevelRange) resultSet failsChangesOffLimits (RangeQuery.rangeLimit iTopLevelRange) resultSet
pure resultSet pure resultSet
singleUpsertQuery :: MutateRequest.MutateRequest -> ReadRequest -> ApiRequest -> AppConfig -> DbHandler ResultSet singleUpsertQuery :: MutatePlan -> ReadPlanTree -> ApiRequest -> AppConfig -> DbHandler ResultSet
singleUpsertQuery mutateReq readReq apiReq conf = do singleUpsertQuery mutateReq readReq apiReq conf = do
resultSet <- writeQuery mutateReq readReq False mempty apiReq conf resultSet <- writeQuery mutateReq readReq False mempty apiReq conf
failPut resultSet failPut resultSet
@@ -137,23 +137,23 @@ failPut RSStandard{rsQueryTotal=queryTotal} =
lift SQL.condemn lift SQL.condemn
throwError Error.PutMatchingPkError throwError Error.PutMatchingPkError
deleteQuery :: MutateRequest.MutateRequest -> ReadRequest -> ApiRequest -> AppConfig -> DbHandler ResultSet deleteQuery :: MutatePlan -> ReadPlanTree -> ApiRequest -> AppConfig -> DbHandler ResultSet
deleteQuery mutateReq readReq apiReq@ApiRequest{..} conf = do deleteQuery mutateReq readReq apiReq@ApiRequest{..} conf = do
resultSet <- writeQuery mutateReq readReq False mempty apiReq conf resultSet <- writeQuery mutateReq readReq False mempty apiReq conf
failNotSingular iAcceptMediaType resultSet failNotSingular iAcceptMediaType resultSet
failsChangesOffLimits (RangeQuery.rangeLimit iTopLevelRange) resultSet failsChangesOffLimits (RangeQuery.rangeLimit iTopLevelRange) resultSet
pure resultSet pure resultSet
invokeQuery :: ProcDescription -> ApiRequestTypes.CallRequest -> ReadRequest -> ApiRequest -> AppConfig -> DbHandler ResultSet invokeQuery :: ProcDescription -> CallPlan -> ReadPlanTree -> ApiRequest -> AppConfig -> DbHandler ResultSet
invokeQuery proc callReq readReq ApiRequest{..} AppConfig{..} = do invokeQuery proc callReq readReq ApiRequest{..} AppConfig{..} = do
resultSet <- resultSet <-
lift . SQL.statement mempty $ lift . SQL.statement mempty $
Statements.prepareCall Statements.prepareCall
(Proc.procReturnsScalar proc) (Proc.procReturnsScalar proc)
(Proc.procReturnsSingle proc) (Proc.procReturnsSingle proc)
(QueryBuilder.requestToCallProcQuery callReq) (QueryBuilder.callPlanToQuery callReq)
(QueryBuilder.readRequestToQuery readReq) (QueryBuilder.readPlanToQuery readReq)
(QueryBuilder.readRequestToCountQuery readReq) (QueryBuilder.readPlanToCountQuery readReq)
(shouldCount iPreferCount) (shouldCount iPreferCount)
iAcceptMediaType iAcceptMediaType
(iPreferParameters == Just MultipleObjects) (iPreferParameters == Just MultipleObjects)
@@ -197,12 +197,12 @@ txMode ApiRequest{..} =
_ -> _ ->
SQL.Write SQL.Write
writeQuery :: MutateRequest.MutateRequest -> ReadRequest -> Bool -> [Text] -> ApiRequest -> AppConfig -> DbHandler ResultSet writeQuery :: MutatePlan -> ReadPlanTree -> Bool -> [Text] -> ApiRequest -> AppConfig -> DbHandler ResultSet
writeQuery mutateReq readReq isInsert pkCols apiReq conf = do writeQuery mutateReq readReq isInsert pkCols apiReq conf = do
lift . SQL.statement mempty $ lift . SQL.statement mempty $
Statements.prepareWrite Statements.prepareWrite
(QueryBuilder.readRequestToQuery readReq) (QueryBuilder.readPlanToQuery readReq)
(QueryBuilder.mutateRequestToQuery mutateReq) (QueryBuilder.mutatePlanToQuery mutateReq)
isInsert isInsert
(iAcceptMediaType apiReq) (iAcceptMediaType apiReq)
(iPreferRepresentation apiReq) (iPreferRepresentation apiReq)
src/PostgREST/Query/QueryBuilder.hs
+34 -33
View File
@@ -5,14 +5,14 @@ Module : PostgREST.Query.QueryBuilder
Description : PostgREST SQL queries generating functions. Description : PostgREST SQL queries generating functions.
This module provides functions to consume data types that This module provides functions to consume data types that
represent database queries (e.g. ReadRequest, MutateRequest) and SqlFragment represent database queries (e.g. ReadPlanTree, MutatePlan) and SqlFragment
to produce SqlQuery type outputs. to produce SqlQuery type outputs.
-} -}
module PostgREST.Query.QueryBuilder module PostgREST.Query.QueryBuilder
( readRequestToQuery ( readPlanToQuery
, mutateRequestToQuery , mutatePlanToQuery
, readRequestToCountQuery , readPlanToCountQuery
, requestToCallProcQuery , callPlanToQuery
, limitedQuery , limitedQuery
) where ) where
@@ -29,35 +29,36 @@ import PostgREST.DbStructure.Relationship (Cardinality (..),
Relationship (..)) Relationship (..))
import PostgREST.Request.Preferences (PreferResolution (..)) import PostgREST.Request.Preferences (PreferResolution (..))
import PostgREST.Plan.CallPlan
import PostgREST.Plan.MutatePlan
import PostgREST.Plan.ReadPlan
import PostgREST.Query.SqlFragment import PostgREST.Query.SqlFragment
import PostgREST.RangeQuery (allRange) import PostgREST.RangeQuery (allRange)
import PostgREST.Request.MutateQuery
import PostgREST.Request.ReadQuery
import PostgREST.Request.Types import PostgREST.Request.Types
import Protolude import Protolude
readRequestToQuery :: ReadRequest -> SQL.Snippet readPlanToQuery :: ReadPlanTree -> SQL.Snippet
readRequestToQuery (Node (Select colSelects mainQi tblAlias logicForest joinConditions_ ordts range, (_, rel, _, _, _, _)) forest) = readPlanToQuery (Node ReadPlan{select,from=mainQi,fromAlias,where_=logicForest,joinConditions, order, range_=readRange, nodeRel} forest) =
"SELECT " <> "SELECT " <>
intercalateSnippet ", " ((pgFmtSelectItem qi <$> colSelects) ++ selects) <> " " <> intercalateSnippet ", " ((pgFmtSelectItem qi <$> select) ++ selects) <> " " <>
fromFrag <> " " <> fromFrag <> " " <>
intercalateSnippet " " joins <> " " <> intercalateSnippet " " joins <> " " <>
(if null logicForest && null joinConditions_ (if null logicForest && null joinConditions
then mempty then mempty
else "WHERE " <> intercalateSnippet " AND " (map (pgFmtLogicTree qi) logicForest ++ map pgFmtJoinCondition joinConditions_)) <> " " <> else "WHERE " <> intercalateSnippet " AND " (map (pgFmtLogicTree qi) logicForest ++ map pgFmtJoinCondition joinConditions)) <> " " <>
orderF qi ordts <> " " <> orderF qi order <> " " <>
limitOffsetF range limitOffsetF readRange
where where
fromFrag = fromF rel mainQi tblAlias fromFrag = fromF nodeRel mainQi fromAlias
qi = getQualifiedIdentifier rel mainQi tblAlias qi = getQualifiedIdentifier nodeRel mainQi fromAlias
(selects, joins) = foldr getSelectsJoins ([],[]) forest (selects, joins) = foldr getSelectsJoins ([],[]) forest
getSelectsJoins :: ReadRequest -> ([SQL.Snippet], [SQL.Snippet]) -> ([SQL.Snippet], [SQL.Snippet]) getSelectsJoins :: ReadPlanTree -> ([SQL.Snippet], [SQL.Snippet]) -> ([SQL.Snippet], [SQL.Snippet])
getSelectsJoins (Node (_, (_, Nothing, _, _, _, _)) _) _ = ([], []) getSelectsJoins (Node ReadPlan{nodeRel=Nothing} _) _ = ([], [])
getSelectsJoins rr@(Node (_, (name, Just rel, alias, _, joinType, _)) _) (selects,joins) = getSelectsJoins rr@(Node ReadPlan{nodeName=name, nodeRel=Just rel, nodeAlias=alias, nodeJoinType=joinType} _) (selects,joins) =
let let
subquery = readRequestToQuery rr subquery = readPlanToQuery rr
aliasOrName = fromMaybe name alias aliasOrName = fromMaybe name alias
locTblName = qiName (relTable rel) <> "_" <> aliasOrName locTblName = qiName (relTable rel) <> "_" <> aliasOrName
localTableName = pgFmtIdent locTblName localTableName = pgFmtIdent locTblName
@@ -82,8 +83,8 @@ getSelectsJoins rr@(Node (_, (name, Just rel, alias, _, joinType, _)) _) (select
in in
(sel:selects, joi:joins) (sel:selects, joi:joins)
mutateRequestToQuery :: MutateRequest -> SQL.Snippet mutatePlanToQuery :: MutatePlan -> SQL.Snippet
mutateRequestToQuery (Insert mainQi iCols body onConflct putConditions returnings) = mutatePlanToQuery (Insert mainQi iCols body onConflct putConditions returnings) =
"WITH " <> normalizedBody body <> " " <> "WITH " <> normalizedBody body <> " " <>
"INSERT INTO " <> SQL.sql (fromQi mainQi) <> SQL.sql (if S.null iCols then " " else "(" <> cols <> ") ") <> "INSERT INTO " <> SQL.sql (fromQi mainQi) <> SQL.sql (if S.null iCols then " " else "(" <> cols <> ") ") <>
"SELECT " <> SQL.sql cols <> " " <> "SELECT " <> SQL.sql cols <> " " <>
@@ -109,7 +110,7 @@ mutateRequestToQuery (Insert mainQi iCols body onConflct putConditions returning
cols = BS.intercalate ", " $ pgFmtIdent <$> S.toList iCols cols = BS.intercalate ", " $ pgFmtIdent <$> S.toList iCols
-- An update without a limit is always filtered with a WHERE -- An update without a limit is always filtered with a WHERE
mutateRequestToQuery (Update mainQi uCols body logicForest range ordts returnings) mutatePlanToQuery (Update mainQi uCols body logicForest range ordts returnings)
| S.null uCols = | S.null uCols =
-- if there are no columns we cannot do UPDATE table SET {empty}, it'd be invalid syntax -- if there are no columns we cannot do UPDATE table SET {empty}, it'd be invalid syntax
-- selecting an empty resultset from mainQi gives us the column names to prevent errors when using &select= -- selecting an empty resultset from mainQi gives us the column names to prevent errors when using &select=
@@ -145,7 +146,7 @@ mutateRequestToQuery (Update mainQi uCols body logicForest range ordts returning
rangeCols = BS.intercalate ", " ((\col -> pgFmtIdent col <> " = (SELECT " <> pgFmtIdent col <> " FROM pgrst_update_body) ") <$> S.toList uCols) rangeCols = BS.intercalate ", " ((\col -> pgFmtIdent col <> " = (SELECT " <> pgFmtIdent col <> " FROM pgrst_update_body) ") <$> S.toList uCols)
(whereRangeIdF, rangeIdF) = mutRangeF mainQi (fst . otTerm <$> ordts) (whereRangeIdF, rangeIdF) = mutRangeF mainQi (fst . otTerm <$> ordts)
mutateRequestToQuery (Delete mainQi logicForest range ordts returnings) mutatePlanToQuery (Delete mainQi logicForest range ordts returnings)
| range == allRange = | range == allRange =
"DELETE FROM " <> SQL.sql (fromQi mainQi) <> " " <> "DELETE FROM " <> SQL.sql (fromQi mainQi) <> " " <>
whereLogic <> " " <> whereLogic <> " " <>
@@ -168,8 +169,8 @@ mutateRequestToQuery (Delete mainQi logicForest range ordts returnings)
whereLogic = if null logicForest then mempty else " WHERE " <> intercalateSnippet " AND " (pgFmtLogicTree mainQi <$> logicForest) whereLogic = if null logicForest then mempty else " WHERE " <> intercalateSnippet " AND " (pgFmtLogicTree mainQi <$> logicForest)
(whereRangeIdF, rangeIdF) = mutRangeF mainQi (fst . otTerm <$> ordts) (whereRangeIdF, rangeIdF) = mutRangeF mainQi (fst . otTerm <$> ordts)
requestToCallProcQuery :: CallRequest -> SQL.Snippet callPlanToQuery :: CallPlan -> SQL.Snippet
requestToCallProcQuery (FunctionCall qi params args returnsScalar multipleCall returnings) = callPlanToQuery (FunctionCall qi params args returnsScalar multipleCall returnings) =
prmsCTE <> argsBody prmsCTE <> argsBody
where where
(prmsCTE, argFrag) = case params of (prmsCTE, argFrag) = case params of
@@ -223,8 +224,8 @@ requestToCallProcQuery (FunctionCall qi params args returnsScalar multipleCall r
-- For this case, we use a WHERE EXISTS instead of an INNER JOIN on the count query. -- For this case, we use a WHERE EXISTS instead of an INNER JOIN on the count query.
-- See https://github.com/PostgREST/postgrest/issues/2009#issuecomment-977473031 -- See https://github.com/PostgREST/postgrest/issues/2009#issuecomment-977473031
-- Only for the nodes that have an INNER JOIN linked to the root level. -- Only for the nodes that have an INNER JOIN linked to the root level.
readRequestToCountQuery :: ReadRequest -> SQL.Snippet readPlanToCountQuery :: ReadPlanTree -> SQL.Snippet
readRequestToCountQuery (Node (Select{from=mainQi, fromAlias=tblAlias, where_=logicForest, joinConditions=joinConditions_}, (_, rel, _, _, _, _)) forest) = readPlanToCountQuery (Node ReadPlan{from=mainQi, fromAlias=tblAlias, where_=logicForest, joinConditions=joinConditions_, nodeRel=rel} forest) =
"SELECT 1 " <> fromFrag <> "SELECT 1 " <> fromFrag <>
(if null logicForest && null joinConditions_ && null subQueries (if null logicForest && null joinConditions_ && null subQueries
then mempty then mempty
@@ -238,16 +239,16 @@ readRequestToCountQuery (Node (Select{from=mainQi, fromAlias=tblAlias, where_=lo
qi = getQualifiedIdentifier rel mainQi tblAlias qi = getQualifiedIdentifier rel mainQi tblAlias
fromFrag = fromF rel mainQi tblAlias fromFrag = fromF rel mainQi tblAlias
subQueries = foldr existsSubquery [] forest subQueries = foldr existsSubquery [] forest
existsSubquery :: ReadRequest -> [SQL.Snippet] -> [SQL.Snippet] existsSubquery :: ReadPlanTree -> [SQL.Snippet] -> [SQL.Snippet]
existsSubquery readReq@(Node (_, (_, _, _, _, joinType, _)) _) rest = existsSubquery readReq@(Node ReadPlan{nodeJoinType=joinType} _) rest =
if joinType == Just JTInner if joinType == Just JTInner
then ("EXISTS (" <> readRequestToCountQuery readReq <> " )"):rest then ("EXISTS (" <> readPlanToCountQuery readReq <> " )"):rest
else rest else rest
limitedQuery :: SQL.Snippet -> Maybe Integer -> SQL.Snippet limitedQuery :: SQL.Snippet -> Maybe Integer -> SQL.Snippet
limitedQuery query maxRows = query <> SQL.sql (maybe mempty (\x -> " LIMIT " <> BS.pack (show x)) maxRows) limitedQuery query maxRows = query <> SQL.sql (maybe mempty (\x -> " LIMIT " <> BS.pack (show x)) maxRows)
-- TODO refactor so this function is uneeded and ComputedRelationship QualifiedIdentifier comes from the ReadQuery type -- TODO refactor so this function is uneeded and ComputedRelationship QualifiedIdentifier comes from the ReadPlan type
getQualifiedIdentifier :: Maybe Relationship -> QualifiedIdentifier -> Maybe Alias -> QualifiedIdentifier getQualifiedIdentifier :: Maybe Relationship -> QualifiedIdentifier -> Maybe Alias -> QualifiedIdentifier
getQualifiedIdentifier rel mainQi tblAlias = case rel of getQualifiedIdentifier rel mainQi tblAlias = case rel of
Just ComputedRelationship{relFunction} -> QualifiedIdentifier mempty $ fromMaybe (qiName relFunction) tblAlias Just ComputedRelationship{relFunction} -> QualifiedIdentifier mempty $ fromMaybe (qiName relFunction) tblAlias
src/PostgREST/Request/Types.hs
+1 -22
View File
@@ -9,9 +9,6 @@ module PostgREST.Request.Types
, Field , Field
, Filter(..) , Filter(..)
, Hint , Hint
, CallQuery(..)
, CallParams(..)
, CallRequest
, JoinCondition(..) , JoinCondition(..)
, JoinType(..) , JoinType(..)
, JsonOperand(..) , JsonOperand(..)
@@ -35,12 +32,9 @@ module PostgREST.Request.Types
, SelectItem , SelectItem
) where ) where
import qualified Data.ByteString.Lazy as LBS
import PostgREST.DbStructure.Identifiers (FieldName, import PostgREST.DbStructure.Identifiers (FieldName,
QualifiedIdentifier) QualifiedIdentifier)
import PostgREST.DbStructure.Proc (ProcDescription (..), import PostgREST.DbStructure.Proc (ProcDescription (..))
ProcParam (..))
import PostgREST.DbStructure.Relationship (Relationship) import PostgREST.DbStructure.Relationship (Relationship)
import PostgREST.MediaType (MediaType (..)) import PostgREST.MediaType (MediaType (..))
@@ -75,8 +69,6 @@ data RangeError
| LowerGTUpper | LowerGTUpper
| OutOfBounds Text Text | OutOfBounds Text Text
type CallRequest = CallQuery
type NodeName = Text type NodeName = Text
type Depth = Integer type Depth = Integer
@@ -103,19 +95,6 @@ data OrderNulls
| OrderNullsLast | OrderNullsLast
deriving (Eq) deriving (Eq)
data CallQuery = FunctionCall
{ funCQi :: QualifiedIdentifier
, funCParams :: CallParams
, funCArgs :: Maybe LBS.ByteString
, funCScalar :: Bool
, funCMultipleCall :: Bool
, funCReturning :: [FieldName]
}
data CallParams
= KeyParams [ProcParam] -- ^ Call with key params: func(a := val1, b:= val2)
| OnePosParam ProcParam -- ^ Call with positional params(only one supported): func(val)
type Field = (FieldName, JsonPath) type Field = (FieldName, JsonPath)
type Cast = Text type Cast = Text
type Alias = Text type Alias = Text
test/spec/QueryCost.hs
+7 -7
View File
@@ -14,8 +14,8 @@ import Text.Heredoc
import Protolude hiding (get, toS) import Protolude hiding (get, toS)
import PostgREST.Query.QueryBuilder (requestToCallProcQuery) import PostgREST.Plan.CallPlan
import PostgREST.Request.Types import PostgREST.Query.QueryBuilder (callPlanToQuery)
import PostgREST.DbStructure.Identifiers import PostgREST.DbStructure.Identifiers
import PostgREST.DbStructure.Proc import PostgREST.DbStructure.Proc
@@ -30,7 +30,7 @@ main = do
context "call proc query" $ do context "call proc query" $ do
it "should not exceed cost when calling setof composite proc" $ do it "should not exceed cost when calling setof composite proc" $ do
cost <- exec pool $ cost <- exec pool $
requestToCallProcQuery (FunctionCall (QualifiedIdentifier "test" "get_projects_below") callPlanToQuery (FunctionCall (QualifiedIdentifier "test" "get_projects_below")
(KeyParams [ProcParam "id" "int" True False]) (KeyParams [ProcParam "id" "int" True False])
(Just [str| {"id": 3} |]) False False []) (Just [str| {"id": 3} |]) False False [])
liftIO $ liftIO $
@@ -38,13 +38,13 @@ main = do
it "should not exceed cost when calling setof composite proc with empty params" $ do it "should not exceed cost when calling setof composite proc with empty params" $ do
cost <- exec pool $ cost <- exec pool $
requestToCallProcQuery (FunctionCall (QualifiedIdentifier "test" "getallprojects") (KeyParams []) Nothing False False []) callPlanToQuery (FunctionCall (QualifiedIdentifier "test" "getallprojects") (KeyParams []) Nothing False False [])
liftIO $ liftIO $
cost `shouldSatisfy` (< Just 30) cost `shouldSatisfy` (< Just 30)
it "should not exceed cost when calling scalar proc" $ do it "should not exceed cost when calling scalar proc" $ do
cost <- exec pool $ cost <- exec pool $
requestToCallProcQuery (FunctionCall (QualifiedIdentifier "test" "add_them") callPlanToQuery (FunctionCall (QualifiedIdentifier "test" "add_them")
(KeyParams [ProcParam "a" "int" True False, ProcParam "b" "int" True False]) (KeyParams [ProcParam "a" "int" True False, ProcParam "b" "int" True False])
(Just [str| {"a": 3, "b": 4} |]) True False []) (Just [str| {"a": 3, "b": 4} |]) True False [])
liftIO $ liftIO $
@@ -53,7 +53,7 @@ main = do
context "params=multiple-objects" $ do context "params=multiple-objects" $ do
it "should not exceed cost when calling setof composite proc" $ do it "should not exceed cost when calling setof composite proc" $ do
cost <- exec pool $ cost <- exec pool $
requestToCallProcQuery (FunctionCall (QualifiedIdentifier "test" "get_projects_below") callPlanToQuery (FunctionCall (QualifiedIdentifier "test" "get_projects_below")
(KeyParams [ProcParam "id" "int" True False]) (KeyParams [ProcParam "id" "int" True False])
(Just [str| [{"id": 1}, {"id": 4}] |]) False True []) (Just [str| [{"id": 1}, {"id": 4}] |]) False True [])
liftIO $ do liftIO $ do
@@ -63,7 +63,7 @@ main = do
it "should not exceed cost when calling scalar proc" $ do it "should not exceed cost when calling scalar proc" $ do
cost <- exec pool $ cost <- exec pool $
requestToCallProcQuery (FunctionCall (QualifiedIdentifier "test" "add_them") callPlanToQuery (FunctionCall (QualifiedIdentifier "test" "add_them")
(KeyParams [ProcParam "a" "int" True False, ProcParam "b" "int" True False]) (KeyParams [ProcParam "a" "int" True False, ProcParam "b" "int" True False])
(Just [str| [{"a": 3, "b": 4}, {"a": 1, "b": 2}, {"a": 8, "b": 7}] |]) True False []) (Just [str| [{"a": 3, "b": 4}, {"a": 1, "b": 2}, {"a": 8, "b": 7}] |]) True False [])
liftIO $ liftIO $