diff --git a/src/PostgREST/ApiRequest/QueryParams.hs b/src/PostgREST/ApiRequest/QueryParams.hs index 6648d9a47..d6515068f 100644 --- a/src/PostgREST/ApiRequest/QueryParams.hs +++ b/src/PostgREST/ApiRequest/QueryParams.hs @@ -60,12 +60,6 @@ import PostgREST.ApiRequest.Types (EmbedParam (..), EmbedPath, Field, import Protolude hiding (try) - --- $setup --- Setup for doctests --- >>> import Text.Pretty.Simple (pPrint) --- >>> deriving instance Show QPError - data QueryParams = QueryParams { qsCanonical :: ByteString diff --git a/src/PostgREST/ApiRequest/Types.hs b/src/PostgREST/ApiRequest/Types.hs index d6a938b7c..fae7b993c 100644 --- a/src/PostgREST/ApiRequest/Types.hs +++ b/src/PostgREST/ApiRequest/Types.hs @@ -86,12 +86,15 @@ data ApiRequestError | UnacceptableSchema [Text] | UnsupportedMethod ByteString | ColumnNotFound Text Text + deriving Show data QPError = QPError Text Text + deriving Show data RangeError = NegativeLimit | LowerGTUpper | OutOfBounds Text Text + deriving Show type NodeName = Text type Depth = Integer diff --git a/src/PostgREST/Plan.hs b/src/PostgREST/Plan.hs index 0d4897381..e3c7ca654 100644 --- a/src/PostgREST/Plan.hs +++ b/src/PostgREST/Plan.hs @@ -82,6 +82,10 @@ import qualified PostgREST.ApiRequest.QueryParams as QueryParams import Protolude hiding (from) +-- $setup +-- Setup for doctests +-- >>> import Data.Ranged.Ranges (fullRange) + data WrappedReadPlan = WrappedReadPlan { wrReadPlan :: ReadPlanTree , wrTxMode :: SQL.Mode @@ -552,24 +556,92 @@ addRelatedOrders (Node rp@ReadPlan{order,from} forest) = do Nothing -> Left $ NotEmbedded otRelation --- Searches for null filters on embeds, e.g. `clients` on /projects?select=*,clients()&clients=not.is.null. --- If these are found, it changes the filter to use the internal aggregate name(`projects_clients_1`) so the filter can succeed. --- It fails if operators other than is.null or not.is.null are used. +-- | Searches for null filters on embeds, e.g. `projects=not.is.null` on `GET /clients?select=*,projects(*)&projects=not.is.null` +-- +-- Setup: +-- +-- >>> let nullOp = OpExpr True (Is TriNull) +-- >>> let nonNullOp = OpExpr False (Is TriNull) +-- >>> let notEqOp = OpExpr True (Op OpNotEqual "val") +-- >>> :{ +-- -- this represents the `projects(*)` part on `/clients?select=*,projects(*)` +-- let +-- subForestPlan = +-- [ +-- Node { +-- rootLabel = ReadPlan { +-- select = [], -- there will be fields at this stage but we just omit them for brevity +-- from = QualifiedIdentifier {qiSchema = "test", qiName = "projects"}, +-- fromAlias = Just "projects_1", where_ = [], order = [], range_ = fullRange, +-- relName = "projects", +-- relToParent = Nothing, +-- relJoinConds = [], +-- relAlias = Nothing, relAggAlias = "clients_projects_1", relHint = Nothing, relJoinType = Nothing, relIsSpread = False, depth = 1 +-- }, +-- subForest = [] +-- } +-- ] +-- :} +-- +-- >>> :{ +-- -- this represents the full URL `/clients?select=*,projects(*)&projects=not.is.null`, if subForst takes the above subForestPlan and nullOp +-- let +-- readPlanTree op subForst = +-- Node { +-- rootLabel = ReadPlan { +-- select = [], -- there will be fields at this stage but we just omit them for brevity +-- from = QualifiedIdentifier { qiSchema = "test", qiName = "clients"}, +-- fromAlias = Nothing, +-- where_ = [ +-- CoercibleStmnt ( +-- CoercibleFilter { +-- field = CoercibleField {cfName = "projects", cfJsonPath = [], cfIRType = "", cfTransform = Nothing, cfDefault = Nothing}, +-- opExpr = op +-- } +-- ) +-- ], +-- order = [], range_ = fullRange, relName = "clients", relToParent = Nothing, relJoinConds = [], relAlias = Nothing, relAggAlias = "", relHint = Nothing, +-- relJoinType = Nothing, relIsSpread = False, depth = 0 +-- }, +-- subForest = subForst +-- } +-- :} +-- +-- Don't do anything to the filter if there's no embedding (a subtree) on projects. Assume it's a normal filter. +-- +-- >>> ReadPlan.where_ . rootLabel <$> addNullEmbedFilters (readPlanTree nullOp []) +-- Right [CoercibleStmnt (CoercibleFilter {field = CoercibleField {cfName = "projects", cfJsonPath = [], cfIRType = "", cfTransform = Nothing, cfDefault = Nothing}, opExpr = OpExpr True (Is TriNull)})] +-- +-- If there's an embedding on projects, then change the filter to use the internal aggregate name (`clients_projects_1`) so the filter can succeed later. +-- +-- >>> ReadPlan.where_ . rootLabel <$> addNullEmbedFilters (readPlanTree nullOp subForestPlan) +-- Right [CoercibleStmnt (CoercibleFilterNullEmbed True "clients_projects_1")] +-- +-- >>> ReadPlan.where_ . rootLabel <$> addNullEmbedFilters (readPlanTree nonNullOp subForestPlan) +-- Right [CoercibleStmnt (CoercibleFilterNullEmbed False "clients_projects_1")] +-- +-- It fails if operators other than is.null or not.is.null on the embedding are used. +-- +-- >>> ReadPlan.where_ . rootLabel <$> addNullEmbedFilters (readPlanTree notEqOp subForestPlan) +-- Left (UnacceptableFilter "projects") addNullEmbedFilters :: ReadPlanTree -> Either ApiRequestError ReadPlanTree -addNullEmbedFilters (Node rp@ReadPlan{where_=oldLogic} forest) = do - let readPlans = rootLabel <$> forest - newLogic <- getFilters readPlans `traverse` oldLogic +addNullEmbedFilters (Node rp@ReadPlan{where_=curLogic} forest) = do + let forestReadPlans = rootLabel <$> forest + newLogic <- newNullFilters forestReadPlans `traverse` curLogic Node rp{ReadPlan.where_= newLogic} <$> (addNullEmbedFilters `traverse` forest) where - getFilters :: [ReadPlan] -> CoercibleLogicTree -> Either ApiRequestError CoercibleLogicTree - getFilters rPlans (CoercibleExpr b lOp trees) = CoercibleExpr b lOp <$> (getFilters rPlans `traverse` trees) - getFilters rPlans flt@(CoercibleStmnt (CoercibleFilter (CoercibleField fld [] _ _ _) opExpr)) = - let foundRP = find (\ReadPlan{relName, relAlias} -> fld == fromMaybe relName relAlias) rPlans in - case (foundRP, opExpr) of - (Just ReadPlan{relAggAlias}, OpExpr b (Is TriNull)) -> Right $ CoercibleStmnt $ CoercibleFilterNullEmbed b relAggAlias - (Just ReadPlan{relName}, _) -> Left $ UnacceptableFilter relName - _ -> Right flt - getFilters _ flt@(CoercibleStmnt _) = Right flt + newNullFilters :: [ReadPlan] -> CoercibleLogicTree -> Either ApiRequestError CoercibleLogicTree + newNullFilters rPlans = \case + (CoercibleExpr b lOp trees) -> + CoercibleExpr b lOp <$> (newNullFilters rPlans `traverse` trees) + flt@(CoercibleStmnt (CoercibleFilter (CoercibleField fld [] _ _ _) opExpr)) -> + let foundRP = find (\ReadPlan{relName, relAlias} -> fld == fromMaybe relName relAlias) rPlans in + case (foundRP, opExpr) of + (Just ReadPlan{relAggAlias}, OpExpr b (Is TriNull)) -> Right $ CoercibleStmnt $ CoercibleFilterNullEmbed b relAggAlias + (Just ReadPlan{relName}, _) -> Left $ UnacceptableFilter relName + _ -> Right flt + flt@(CoercibleStmnt _) -> + Right flt addRanges :: ApiRequest -> ReadPlanTree -> Either ApiRequestError ReadPlanTree addRanges ApiRequest{..} rReq = diff --git a/src/PostgREST/SchemaCache/Routine.hs b/src/PostgREST/SchemaCache/Routine.hs index b47dca404..676c0fa6f 100644 --- a/src/PostgREST/SchemaCache/Routine.hs +++ b/src/PostgREST/SchemaCache/Routine.hs @@ -29,18 +29,18 @@ import Protolude data PgType = Scalar QualifiedIdentifier | Composite QualifiedIdentifier Bool -- True if the composite is a domain alias(used to work around a bug in pg 11 and 12, see QueryBuilder.hs) - deriving (Eq, Ord, Generic, JSON.ToJSON) + deriving (Eq, Show, Ord, Generic, JSON.ToJSON) data RetType = Single PgType | SetOf PgType - deriving (Eq, Ord, Generic, JSON.ToJSON) + deriving (Eq, Show, Ord, Generic, JSON.ToJSON) data FuncVolatility = Volatile | Stable | Immutable - deriving (Eq, Ord, Generic, JSON.ToJSON) + deriving (Eq, Show, Ord, Generic, JSON.ToJSON) data Routine = Function { pdSchema :: Schema @@ -52,7 +52,7 @@ data Routine = Function , pdHasVariadic :: Bool , pdIsoLvl :: Maybe SQL.IsolationLevel } - deriving (Eq, Generic) + deriving (Eq, Show, Generic) -- need to define JSON manually bc SQL.IsolationLevel doesn't have a JSON instance(and we can't define one for that type without getting a compiler error) instance JSON.ToJSON Routine where toJSON (Function sch nam desc params ret vol hasVar _) = JSON.object @@ -72,7 +72,7 @@ data RoutineParam = RoutineParam , ppReq :: Bool , ppVar :: Bool } - deriving (Eq, Ord, Generic, JSON.ToJSON) + deriving (Eq, Show, Ord, Generic, JSON.ToJSON) -- Order by least number of params in the case of overloaded functions instance Ord Routine where diff --git a/test/doc/Main.hs b/test/doc/Main.hs index 8c59c954b..1a0b5ac42 100644 --- a/test/doc/Main.hs +++ b/test/doc/Main.hs @@ -11,6 +11,7 @@ main = [ "-XOverloadedStrings" , "-XNoImplicitPrelude" , "-XStandaloneDeriving" + , "-XDuplicateRecordFields" , "-isrc" , "src/PostgREST/Query/SqlFragment.hs" , "src/PostgREST/ApiRequest/Preferences.hs" @@ -18,4 +19,5 @@ main = , "src/PostgREST/Error.hs" , "src/PostgREST/MediaType.hs" , "src/PostgREST/Config.hs" + , "src/PostgREST/Plan.hs" ]