add: config to emit warning for legacy target names
Adds the `url_use_legacy_target_names` config. Enabled (default): * It allows using the resource name in filters, orders or limits when it has an alias, e.g. `table?select=alias:target(*)&target.id=eq.1` * Logs a WARNING with a hint to use the alias * Returns a Warning header in the response Disabled: * It returns an error, only the alias is allowed * No warnings returned This feature is deprecated
This commit is contained in:
steve-chavez
committed by
Laurence Isla
Laurence Isla
parent
2fa8de4e52
commit
490d1dc5d3
+23
-5
@@ -71,7 +71,7 @@ import qualified Data.List as L
|
||||
import Data.Streaming.Network (bindPortTCP)
|
||||
import qualified Data.Text as T
|
||||
import qualified Network.HTTP.Types as HTTP
|
||||
import Network.HTTP.Types.Header (hVary)
|
||||
import Network.HTTP.Types.Header (hVary, hWarning)
|
||||
import qualified Network.Socket as NS
|
||||
import PostgREST.Unix (createAndBindDomainSocket)
|
||||
import System.Posix.Types (FileMode)
|
||||
@@ -210,6 +210,14 @@ postgrestResponse appState conf@AppConfig{..} maybeSchemaCache jwtTime authResul
|
||||
(parseTime, apiReq@ApiRequest{..}) <- withTiming conf $ liftEither . mapLeft Error.ApiRequestErr $ ApiRequest.userApiRequest conf prefs req body
|
||||
(planTime, plan) <- withTiming conf $ liftEither $ Plan.actionPlan iAction conf apiReq sCache
|
||||
|
||||
let warnings = Plan.legacyWarnings plan
|
||||
legacyWarnMsg = "Embedded resource was referenced by relation name even though it has an alias. This is deprecated and will stop working in a future release."
|
||||
legacyWarnHint = let replacement (relName, alias) = "`" <> relName <> "` to `" <> alias <> "`" in T.intercalate ", " (replacement <$> warnings)
|
||||
shouldShowWarnings = configUrlUseLegacyTargetNames && not (null warnings)
|
||||
|
||||
liftIO $ when shouldShowWarnings $
|
||||
observer $ LegacyTargetNameWarningObs (legacyWarnMsg, legacyWarnHint) iMethod (iPath <> Wai.rawQueryString req) -- TODO maybe store rawQueryString in ApiRequest for consistency
|
||||
|
||||
let mainQ = Query.mainQuery plan conf apiReq authResult configDbPreRequest
|
||||
tx = MainTx.mainTx mainQ conf authResult apiReq plan sCache
|
||||
obsQuery s = when configLogQuery $ observer $ QueryObs mainQ s
|
||||
@@ -235,12 +243,14 @@ postgrestResponse appState conf@AppConfig{..} maybeSchemaCache jwtTime authResul
|
||||
liftIO $ obsQuery status'
|
||||
liftEither response
|
||||
|
||||
return $ toWaiResponse (ServerTiming jwtTime parseTime planTime txTime respTime) resp
|
||||
let warnHdrMsgs = if shouldShowWarnings then Just (legacyWarnMsg, legacyWarnHint) else Nothing
|
||||
|
||||
return $ toWaiResponse (ServerTiming jwtTime parseTime planTime txTime respTime) warnHdrMsgs resp
|
||||
|
||||
where
|
||||
toWaiResponse :: ServerTiming -> Response.PgrstResponse -> Wai.Response
|
||||
toWaiResponse timing (Response.PgrstResponse st hdrs bod) =
|
||||
Wai.responseLBS st (hdrs ++ serverTimingHeaders timing ++ [varyHeader | not $ varyHeaderPresent hdrs]) bod
|
||||
toWaiResponse :: ServerTiming -> Maybe (Text, Text) -> Response.PgrstResponse -> Wai.Response
|
||||
toWaiResponse timing warnMsgs (Response.PgrstResponse st hdrs bod) =
|
||||
Wai.responseLBS st (hdrs ++ serverTimingHeaders timing ++ warningHeaders warnMsgs ++ [varyHeader | not $ varyHeaderPresent hdrs]) bod
|
||||
|
||||
serverTimingHeaders :: ServerTiming -> [HTTP.Header]
|
||||
serverTimingHeaders timing = [serverTimingHeader timing | configServerTimingEnabled]
|
||||
@@ -251,6 +261,14 @@ postgrestResponse appState conf@AppConfig{..} maybeSchemaCache jwtTime authResul
|
||||
varyHeaderPresent :: [HTTP.Header] -> Bool
|
||||
varyHeaderPresent = any (\(h, _v) -> h == hVary)
|
||||
|
||||
warningHeaders :: Maybe (Text, Text) -> [HTTP.Header]
|
||||
warningHeaders Nothing = []
|
||||
warningHeaders (Just (msg, hint)) =
|
||||
let warnMsg = msg <> " Update " <> hint <> " in query string filters, orders or limits."
|
||||
pgrstVer = "PostgRESTv" <> BS.filter (/= ' ') prettyVersion
|
||||
in
|
||||
[(hWarning, "299 " <> pgrstVer <> " \"" <> encodeUtf8 warnMsg <> "\"")]
|
||||
|
||||
withTiming :: (MonadError e m, MonadIO m) => AppConfig -> m a -> m (Maybe Double, a)
|
||||
withTiming AppConfig{configServerTimingEnabled} f = if configServerTimingEnabled
|
||||
then do
|
||||
|
||||
@@ -121,6 +121,7 @@ data AppConfig = AppConfig
|
||||
, configServerTimingEnabled :: Bool
|
||||
, configServerUnixSocket :: Maybe FilePath
|
||||
, configServerUnixSocketMode :: FileMode
|
||||
, configUrlUseLegacyTargetNames :: Bool
|
||||
, configAdminServerHost :: Text
|
||||
, configAdminServerPort :: Maybe Int
|
||||
, configAdminServerUnixSocket :: Maybe FilePath
|
||||
@@ -207,6 +208,7 @@ toText conf =
|
||||
,("server-timing-enabled", T.toLower . show . configServerTimingEnabled)
|
||||
,("server-unix-socket", q . maybe mempty T.pack . configServerUnixSocket)
|
||||
,("server-unix-socket-mode", q . T.pack . showSocketMode)
|
||||
,("url-use-legacy-target-names", T.toLower . show . configUrlUseLegacyTargetNames)
|
||||
,("admin-server-host", q . configAdminServerHost)
|
||||
,("admin-server-port", maybe "\"\"" show . configAdminServerPort)
|
||||
,("admin-server-unix-socket", q . maybe mempty T.pack . configAdminServerUnixSocket)
|
||||
@@ -325,6 +327,7 @@ parser optPath env dbSettings roleSettings roleIsolationLvl =
|
||||
<*> (fromMaybe False <$> optBool "server-timing-enabled")
|
||||
<*> (fmap T.unpack <$> optString "server-unix-socket")
|
||||
<*> parseSocketFileMode "server-unix-socket-mode"
|
||||
<*> (fromMaybe True <$> optBool "url-use-legacy-target-names")
|
||||
<*> (defaultServerHost <$> optWithAlias (optString "admin-server-host")
|
||||
(optString "server-host"))
|
||||
<*> parseAdminServerPort "admin-server-port"
|
||||
@@ -794,4 +797,9 @@ exampleConfigFile = S.unlines
|
||||
, "## Unix socket file mode"
|
||||
, "## When none is provided, 660 is applied by default"
|
||||
, "# server-unix-socket-mode = \"660\""
|
||||
, ""
|
||||
, "## Use legacy target names in relationship filters"
|
||||
, "## If active, allows using the target name of the relationship in filters even if it has an alias."
|
||||
, "## Otherwise it only allows the alias in filters"
|
||||
, "url-use-legacy-target-names = true"
|
||||
]
|
||||
|
||||
@@ -71,6 +71,7 @@ dbSettingsNames =
|
||||
,"server_cors_allowed_origins"
|
||||
,"server_trace_header"
|
||||
,"server_timing_enabled"
|
||||
,"url_use_legacy_target_names"
|
||||
]
|
||||
|
||||
queryPgVersion :: Session PgVersion
|
||||
|
||||
@@ -175,7 +175,7 @@ instance ErrorBody ApiRequestError where
|
||||
message InvalidFilters = "Filters must include all and only primary key columns with 'eq' operators"
|
||||
message (UnacceptableSchema sch _) = "Invalid schema: " <> sch
|
||||
message (MediaTypeError cts) = "None of these media types are available: " <> T.intercalate ", " (map T.decodeUtf8 cts)
|
||||
message (NotEmbedded resource) = "'" <> resource <> "' is not an embedded resource in this request"
|
||||
message (NotEmbedded resource _) = "'" <> resource <> "' is not an embedded resource in this request"
|
||||
message GucHeadersError = "response.headers guc must be a JSON array composed of objects with a single key and a string value"
|
||||
message GucStatusError = "response.status guc must be a valid status code"
|
||||
message PutLimitNotAllowedError = "limit/offset querystring parameters are not allowed for PUT"
|
||||
@@ -207,11 +207,13 @@ instance ErrorBody ApiRequestError where
|
||||
details (InvalidPreferences prefs) = Just $ JSON.String $ T.decodeUtf8 ("Invalid preferences: " <> BS.intercalate ", " prefs)
|
||||
details (MaxAffectedViolationError n) = Just $ JSON.String $ T.unwords ["The query affects", show n, "rows"]
|
||||
details (NotImplemented details') = Just $ JSON.String details'
|
||||
details (NotEmbedded _ (Just _)) = Just $ JSON.String "Target names are not allowed in filters if they have an alias"
|
||||
|
||||
details _ = Nothing
|
||||
|
||||
-- HINT: Maybe JSON.Value
|
||||
hint (NotEmbedded resource) = Just $ JSON.String $ "Verify that '" <> resource <> "' is included in the 'select' query parameter."
|
||||
hint (NotEmbedded resource Nothing) = Just $ JSON.String $ "Verify that '" <> resource <> "' is included in the 'select' query parameter."
|
||||
hint (NotEmbedded _ (Just (name, alias))) = Just $ JSON.String $ "Change '" <> name <> "' to '" <> alias <> "' in filters, orders or limits."
|
||||
hint (PGRSTParseError raiseErr) = Just $ JSON.String $ pgrstParseErrorHint raiseErr
|
||||
hint (UnacceptableSchema _ schemas) = Just $ JSON.String $ "Only the following schemas are exposed: " <> T.intercalate ", " schemas
|
||||
|
||||
|
||||
@@ -44,7 +44,7 @@ data ApiRequestError
|
||||
| InvalidPreferences [ByteString]
|
||||
| InvalidRange RangeError
|
||||
| InvalidRpcMethod ByteString
|
||||
| NotEmbedded Text
|
||||
| NotEmbedded Text (Maybe (Text, Text))
|
||||
| NotImplemented Text
|
||||
| PutLimitNotAllowedError
|
||||
| QueryParamError QPError
|
||||
|
||||
@@ -192,6 +192,10 @@ observationMessages = \case
|
||||
let snipts = renderSnippet <$> [mqTxVars, fromMaybe mempty mqPreReq, mqMain, x, y, z, fromMaybe mempty mqExplain]
|
||||
in
|
||||
showOnSingleLine '\n' . T.decodeUtf8 <$> filter (/= mempty) snipts
|
||||
LegacyTargetNameWarningObs (warningMsg, warningHints) requestMethod requestTarget ->
|
||||
[ "WARNING: " <> warningMsg
|
||||
, "Update filters, orders or limits that use " <> warningHints <> " in " <> "`" <> T.decodeUtf8 (requestMethod <> " " <> requestTarget) <> "`"
|
||||
]
|
||||
ConfigReadErrorObs usageErr ->
|
||||
pure $ "Failed to query database settings for the config parameters." <> jsonMessage usageErr
|
||||
QueryRoleSettingsErrorObs usageErr ->
|
||||
|
||||
@@ -45,6 +45,7 @@ data Observation
|
||||
| DBListenerGotConfigMsg ByteString
|
||||
| DBListenerConnectionCleanupFail SomeException
|
||||
| QueryObs MainQuery Status
|
||||
| LegacyTargetNameWarningObs (Text, Text) ByteString ByteString
|
||||
| ConfigReadErrorObs SQL.UsageError
|
||||
| ConfigInvalidObs Text
|
||||
| ConfigSucceededObs
|
||||
|
||||
+69
-30
@@ -23,6 +23,7 @@ module PostgREST.Plan
|
||||
, InspectPlan(..)
|
||||
, InfoPlan(..)
|
||||
, CrudPlan(..)
|
||||
, legacyWarnings
|
||||
) where
|
||||
|
||||
import qualified Data.HashMap.Strict as HM
|
||||
@@ -144,6 +145,25 @@ data InfoPlan
|
||||
| RoutineInfoPlan Routine -- info about function
|
||||
| SchemaInfoPlan -- info about schema cache
|
||||
|
||||
legacyWarnings :: ActionPlan -> [(Text, Text)]
|
||||
legacyWarnings (NoDb _) = []
|
||||
legacyWarnings (Db dbPlan) =
|
||||
case dbPlan of
|
||||
DbCrud _ crudPlan ->
|
||||
readPlanWarnings $ case crudPlan of
|
||||
WrappedReadPlan{wrReadPlan} -> wrReadPlan
|
||||
MutateReadPlan{mrReadPlan} -> mrReadPlan
|
||||
CallReadPlan{crReadPlan} -> crReadPlan
|
||||
MayUseDb _ -> []
|
||||
where
|
||||
readPlanWarnings :: ReadPlanTree -> [(Text, Text)]
|
||||
readPlanWarnings (Node rp forest) =
|
||||
maybeToList (readPlanWarning rp) <> foldMap readPlanWarnings forest
|
||||
|
||||
readPlanWarning :: ReadPlan -> Maybe (Text, Text)
|
||||
readPlanWarning ReadPlan{relName, relAlias = Just alias, relIsLegacyTargetNameMatch = True} = Just (relName, alias)
|
||||
readPlanWarning _ = Nothing
|
||||
|
||||
actionPlan :: Action -> AppConfig -> ApiRequest -> SchemaCache -> Either Error ActionPlan
|
||||
actionPlan act conf apiReq sCache = case act of
|
||||
ActDb dbAct -> Db <$> dbActionPlan dbAct conf apiReq sCache
|
||||
@@ -354,7 +374,7 @@ resolveQueryInputField ctx field opExpr = withTextParse ctx $ resolveTypeOrUnkno
|
||||
-- | Adds filters, order, limits on its respective nodes.
|
||||
-- | Adds joins conditions obtained from resource embedding.
|
||||
readPlan :: QualifiedIdentifier -> AppConfig -> SchemaCache -> ApiRequest -> Either Error ReadPlanTree
|
||||
readPlan qi@QualifiedIdentifier{..} AppConfig{configDbMaxRows, configDbAggregates} SchemaCache{dbTables, dbRelationships, dbRepresentations} apiRequest =
|
||||
readPlan qi@QualifiedIdentifier{..} AppConfig{configDbMaxRows, configDbAggregates, configUrlUseLegacyTargetNames} SchemaCache{dbTables, dbRelationships, dbRepresentations} apiRequest =
|
||||
let
|
||||
-- JSON output format hardcoded for now. In the future we might want to support other output mappings such as CSV.
|
||||
ctx = ResolverContext dbTables dbRepresentations qi "json"
|
||||
@@ -369,10 +389,10 @@ readPlan qi@QualifiedIdentifier{..} AppConfig{configDbMaxRows, configDbAggregate
|
||||
addAliases =<<
|
||||
expandStars ctx =<<
|
||||
addRels qiSchema (iAction apiRequest) dbRelationships Nothing =<<
|
||||
addLogicTrees ctx apiRequest =<<
|
||||
addRanges apiRequest =<<
|
||||
addOrders ctx apiRequest =<<
|
||||
addFilters ctx apiRequest (initReadRequest ctx $ QueryParams.qsSelect $ iQueryParams apiRequest)
|
||||
addLogicTrees ctx apiRequest configUrlUseLegacyTargetNames =<<
|
||||
addRanges apiRequest configUrlUseLegacyTargetNames =<<
|
||||
addOrders ctx apiRequest configUrlUseLegacyTargetNames =<<
|
||||
addFilters ctx apiRequest configUrlUseLegacyTargetNames (initReadRequest ctx $ QueryParams.qsSelect $ iQueryParams apiRequest)
|
||||
|
||||
-- Build the initial read plan tree
|
||||
initReadRequest :: ResolverContext -> [Tree SelectItem] -> ReadPlanTree
|
||||
@@ -380,7 +400,7 @@ initReadRequest ctx@ResolverContext{qi=QualifiedIdentifier{..}} =
|
||||
foldr (treeEntry rootDepth) $ Node defReadPlan{from=qi ctx, relName=qiName, depth=rootDepth} []
|
||||
where
|
||||
rootDepth = 0
|
||||
defReadPlan = ReadPlan [] (QualifiedIdentifier mempty mempty) Nothing [] [] allRange mempty Nothing [] Nothing mempty Nothing Nothing Nothing [] rootDepth
|
||||
defReadPlan = ReadPlan [] (QualifiedIdentifier mempty mempty) Nothing [] [] allRange mempty Nothing [] Nothing mempty Nothing Nothing Nothing [] rootDepth False
|
||||
treeEntry :: Depth -> Tree SelectItem -> ReadPlanTree -> ReadPlanTree
|
||||
treeEntry depth (Node si fldForest) (Node q rForest) =
|
||||
let nxtDepth = succ depth in
|
||||
@@ -816,8 +836,8 @@ findTable qi@QualifiedIdentifier{..} sc@SchemaCache{dbTables} =
|
||||
Nothing -> Left $ SchemaCacheErr $ TableNotFound qiSchema qiName sc
|
||||
Just _ -> Right qi
|
||||
|
||||
addFilters :: ResolverContext -> ApiRequest -> ReadPlanTree -> Either Error ReadPlanTree
|
||||
addFilters ctx ApiRequest{..} rReq =
|
||||
addFilters :: ResolverContext -> ApiRequest -> Bool -> ReadPlanTree -> Either Error ReadPlanTree
|
||||
addFilters ctx ApiRequest{..} useTargetNames rReq =
|
||||
foldr addFilterToNode (Right rReq) flts
|
||||
where
|
||||
QueryParams.QueryParams{..} = iQueryParams
|
||||
@@ -829,15 +849,15 @@ addFilters ctx ApiRequest{..} rReq =
|
||||
|
||||
addFilterToNode :: (EmbedPath, Filter) -> Either Error ReadPlanTree -> Either Error ReadPlanTree
|
||||
addFilterToNode =
|
||||
updateNode (\flt (Node q@ReadPlan{from=fromTable, where_=lf} f) -> Node q{ReadPlan.where_=addFilterToLogicForest (resolveFilter ctx{qi=fromTable} flt) lf} f)
|
||||
updateNode useTargetNames (\flt (Node q@ReadPlan{from=fromTable, where_=lf} f) -> Node q{ReadPlan.where_=addFilterToLogicForest (resolveFilter ctx{qi=fromTable} flt) lf} f)
|
||||
|
||||
addOrders :: ResolverContext -> ApiRequest -> ReadPlanTree -> Either Error ReadPlanTree
|
||||
addOrders ctx ApiRequest{..} rReq = foldr addOrderToNode (Right rReq) qsOrder
|
||||
addOrders :: ResolverContext -> ApiRequest -> Bool -> ReadPlanTree -> Either Error ReadPlanTree
|
||||
addOrders ctx ApiRequest{..} useTargetNames rReq = foldr addOrderToNode (Right rReq) qsOrder
|
||||
where
|
||||
QueryParams.QueryParams{..} = iQueryParams
|
||||
|
||||
addOrderToNode :: (EmbedPath, [OrderTerm]) -> Either Error ReadPlanTree -> Either Error ReadPlanTree
|
||||
addOrderToNode = updateNode (\o (Node q f) -> Node q{order=resolveOrder ctx <$> o} f)
|
||||
addOrderToNode = updateNode useTargetNames (\o (Node q f) -> Node q{order=resolveOrder ctx <$> o} f)
|
||||
|
||||
resolveOrder :: ResolverContext -> OrderTerm -> CoercibleOrderTerm
|
||||
resolveOrder _ (OrderRelationTerm a b c d) = CoercibleOrderRelationTerm a b c d
|
||||
@@ -862,7 +882,7 @@ addRelatedOrders (Node rp@ReadPlan{order,from} forest) = do
|
||||
then Right $ cot{coRelation=relAggAlias}
|
||||
else Left $ ApiRequestErr $ RelatedOrderNotToOne (qiName from) name
|
||||
Nothing ->
|
||||
Left $ ApiRequestErr $ NotEmbedded coRelation
|
||||
Left $ ApiRequestErr $ NotEmbedded coRelation Nothing
|
||||
|
||||
-- | Searches for null filters on embeds, e.g. `projects=not.is.null` on `GET /clients?select=*,projects(*)&projects=not.is.null`
|
||||
--
|
||||
@@ -887,7 +907,8 @@ addRelatedOrders (Node rp@ReadPlan{order,from} forest) = do
|
||||
-- relToParent = Nothing,
|
||||
-- relJoinConds = [],
|
||||
-- relAlias = Nothing, relAggAlias = "clients_projects_1", relHint = Nothing, relJoinType = Nothing, relSpread = Nothing, depth = 1,
|
||||
-- relSelect = []
|
||||
-- relSelect = [],
|
||||
-- relIsLegacyTargetNameMatch = False
|
||||
-- },
|
||||
-- subForest = []
|
||||
-- }
|
||||
@@ -913,7 +934,8 @@ addRelatedOrders (Node rp@ReadPlan{order,from} forest) = do
|
||||
-- ],
|
||||
-- order = [], range_ = fullRange, relName = "clients", relToParent = Nothing, relJoinConds = [], relAlias = Nothing, relAggAlias = "", relHint = Nothing,
|
||||
-- relJoinType = Nothing, relSpread = Nothing, depth = 0,
|
||||
-- relSelect = []
|
||||
-- relSelect = [],
|
||||
-- relIsLegacyTargetNameMatch = False
|
||||
-- },
|
||||
-- subForest = subForst
|
||||
-- }
|
||||
@@ -949,8 +971,8 @@ addNullEmbedFilters (Node rp@ReadPlan{where_=curLogic} forest) = do
|
||||
flt@(CoercibleStmnt _) ->
|
||||
Right flt
|
||||
|
||||
addRanges :: ApiRequest -> ReadPlanTree -> Either Error ReadPlanTree
|
||||
addRanges ApiRequest{..} rReq =
|
||||
addRanges :: ApiRequest -> Bool -> ReadPlanTree -> Either Error ReadPlanTree
|
||||
addRanges ApiRequest{..} useTargetNames rReq =
|
||||
case iAction of
|
||||
ActDb (ActRelationMut _ _) -> Right rReq
|
||||
_ -> foldr addRangeToNode (Right rReq) =<< ranges
|
||||
@@ -959,10 +981,10 @@ addRanges ApiRequest{..} rReq =
|
||||
ranges = first (ApiRequestErr . QueryParamError) $ QueryParams.pRequestRange `traverse` HM.toList iRange
|
||||
|
||||
addRangeToNode :: (EmbedPath, NonnegRange) -> Either Error ReadPlanTree -> Either Error ReadPlanTree
|
||||
addRangeToNode = updateNode (\r (Node q f) -> Node q{range_=r} f)
|
||||
addRangeToNode = updateNode useTargetNames (\r (Node q f) -> Node q{range_=r} f)
|
||||
|
||||
addLogicTrees :: ResolverContext -> ApiRequest -> ReadPlanTree -> Either Error ReadPlanTree
|
||||
addLogicTrees ctx ApiRequest{..} rReq =
|
||||
addLogicTrees :: ResolverContext -> ApiRequest -> Bool -> ReadPlanTree -> Either Error ReadPlanTree
|
||||
addLogicTrees ctx ApiRequest{..} useTargetNames rReq =
|
||||
foldr addLogicTreeToNode (Right rReq) logic
|
||||
where
|
||||
QueryParams.QueryParams{..} = iQueryParams
|
||||
@@ -975,7 +997,7 @@ addLogicTrees ctx ApiRequest{..} rReq =
|
||||
_ -> filter (not . null . fst) qsLogic
|
||||
|
||||
addLogicTreeToNode :: (EmbedPath, LogicTree) -> Either Error ReadPlanTree -> Either Error ReadPlanTree
|
||||
addLogicTreeToNode = updateNode (\t (Node q@ReadPlan{from=fromTable, where_=lf} f) -> Node q{ReadPlan.where_=resolveLogicTree ctx{qi=fromTable} t:lf} f)
|
||||
addLogicTreeToNode = updateNode useTargetNames (\t (Node q@ReadPlan{from=fromTable, where_=lf} f) -> Node q{ReadPlan.where_=resolveLogicTree ctx{qi=fromTable} t:lf} f)
|
||||
|
||||
resolveLogicTree :: ResolverContext -> LogicTree -> CoercibleLogicTree
|
||||
resolveLogicTree ctx (Stmnt flt) = CoercibleStmnt $ resolveFilter ctx flt
|
||||
@@ -985,18 +1007,35 @@ resolveFilter :: ResolverContext -> Filter -> CoercibleFilter
|
||||
resolveFilter ctx (Filter fld opExpr) = CoercibleFilter{field=resolveQueryInputField ctx fld opExpr, opExpr=opExpr}
|
||||
|
||||
-- Find a Node of the Tree and apply a function to it
|
||||
updateNode :: (a -> ReadPlanTree -> ReadPlanTree) -> (EmbedPath, a) -> Either Error ReadPlanTree -> Either Error ReadPlanTree
|
||||
updateNode f ([], a) rr = f a <$> rr
|
||||
updateNode _ _ (Left e) = Left e
|
||||
updateNode f (targetNodeName:remainingPath, a) (Right (Node rootNode forest)) =
|
||||
case findNode of
|
||||
Nothing -> Left $ ApiRequestErr $ NotEmbedded targetNodeName
|
||||
updateNode :: Bool -> (a -> ReadPlanTree -> ReadPlanTree) -> (EmbedPath, a) -> Either Error ReadPlanTree -> Either Error ReadPlanTree
|
||||
updateNode _ f ([], a) rr = f a <$> rr
|
||||
updateNode _ _ _ (Left e) = Left e
|
||||
updateNode useTargetNames f (targetNodeName:remainingPath, a) (Right (Node rootNode forest)) =
|
||||
case findNode useTargetNames of
|
||||
Nothing ->
|
||||
Left $ ApiRequestErr $ NotEmbedded targetNodeName findLegacyUsage
|
||||
Just target ->
|
||||
(\node -> Node rootNode $ node : delete target forest) <$>
|
||||
updateNode f (remainingPath, a) (Right target)
|
||||
updateNode useTargetNames f (remainingPath, a) (Right $ updateLegacyAttrs target)
|
||||
where
|
||||
findNode :: Maybe ReadPlanTree
|
||||
findNode = find (\(Node ReadPlan{relName, relAlias} _) -> fromMaybe relName relAlias == targetNodeName) forest
|
||||
findNode :: Bool -> Maybe ReadPlanTree
|
||||
findNode isLegacy = find (matchTarget isLegacy) forest
|
||||
|
||||
matchTarget :: Bool -> ReadPlanTree -> Bool
|
||||
matchTarget isLegacy (Node ReadPlan{relName, relAlias} _)
|
||||
| isLegacy = relName == targetNodeName || relAlias == Just targetNodeName
|
||||
| otherwise = fromMaybe relName relAlias == targetNodeName
|
||||
|
||||
updateLegacyAttrs :: ReadPlanTree -> ReadPlanTree
|
||||
updateLegacyAttrs node@(Node rPlan@ReadPlan{relName, relAlias} children)
|
||||
| relName == targetNodeName && isJust relAlias && relAlias /= Just targetNodeName =
|
||||
Node rPlan{relIsLegacyTargetNameMatch=True} children
|
||||
| otherwise = node
|
||||
|
||||
findLegacyUsage :: Maybe (Text, Text)
|
||||
findLegacyUsage
|
||||
| useTargetNames = Nothing
|
||||
| otherwise = (\(Node rp _) -> fromMaybe mempty $ readPlanWarning rp) . updateLegacyAttrs <$> findNode True
|
||||
|
||||
mutatePlan :: Mutation -> QualifiedIdentifier -> ApiRequest -> SchemaCache -> ReadPlanTree -> Either Error MutatePlan
|
||||
mutatePlan mutation qi ApiRequest{iPreferences=Preferences{..}, ..} SchemaCache{dbTables, dbRepresentations} readReq =
|
||||
|
||||
@@ -32,22 +32,22 @@ data JoinCondition =
|
||||
|
||||
-- TODO: Enforce uniqueness of columns by changing to a Set instead of a List where applicable
|
||||
data ReadPlan = ReadPlan
|
||||
{ select :: [CoercibleSelectField]
|
||||
, from :: QualifiedIdentifier
|
||||
, fromAlias :: Maybe Alias
|
||||
, where_ :: [CoercibleLogicTree]
|
||||
, order :: [CoercibleOrderTerm]
|
||||
, range_ :: NonnegRange
|
||||
, relName :: NodeName
|
||||
, relToParent :: Maybe Relationship
|
||||
, relJoinConds :: [JoinCondition]
|
||||
, relAlias :: Maybe Alias
|
||||
, relAggAlias :: Alias
|
||||
, relHint :: Maybe Hint
|
||||
, relJoinType :: Maybe JoinType
|
||||
, relSpread :: Maybe SpreadType
|
||||
, relSelect :: [RelSelectField]
|
||||
, depth :: Depth
|
||||
-- ^ used for aliasing
|
||||
{ select :: [CoercibleSelectField]
|
||||
, from :: QualifiedIdentifier
|
||||
, fromAlias :: Maybe Alias
|
||||
, where_ :: [CoercibleLogicTree]
|
||||
, order :: [CoercibleOrderTerm]
|
||||
, range_ :: NonnegRange
|
||||
, relName :: NodeName
|
||||
, relToParent :: Maybe Relationship
|
||||
, relJoinConds :: [JoinCondition]
|
||||
, relAlias :: Maybe Alias
|
||||
, relAggAlias :: Alias
|
||||
, relHint :: Maybe Hint
|
||||
, relJoinType :: Maybe JoinType
|
||||
, relSpread :: Maybe SpreadType
|
||||
, relSelect :: [RelSelectField]
|
||||
, depth :: Depth -- ^ used for aliasing
|
||||
, relIsLegacyTargetNameMatch :: Bool -- ^ used to ease migration into a new version with breaking change
|
||||
}
|
||||
deriving (Eq, Show)
|
||||
|
||||
Reference in New Issue
Block a user