From fdffb1001ece65236f783a1855619016cbff8e49 Mon Sep 17 00:00:00 2001 From: Auke Booij Date: Tue, 28 Apr 2020 16:12:08 +0200 Subject: [PATCH] Validation code simplifications Rather than defining a new monad class and constructing new instances of it, just use the `StateT` that it is really based on. Also get rid of some dead code, and Monoid instances that aren't actually Monoids. Also avoid an instance of Lenses where this doesn't add much value. --- server/src-lib/Hasura/GraphQL/Execute.hs | 3 +- .../Hasura/GraphQL/Execute/LiveQuery/Plan.hs | 9 ++- .../src-lib/Hasura/GraphQL/Execute/Query.hs | 7 ++- server/src-lib/Hasura/GraphQL/Resolve.hs | 1 + .../src-lib/Hasura/GraphQL/Resolve/Types.hs | 3 - .../src-lib/Hasura/GraphQL/Validate/Types.hs | 63 +++++-------------- 6 files changed, 30 insertions(+), 56 deletions(-) diff --git a/server/src-lib/Hasura/GraphQL/Execute.hs b/server/src-lib/Hasura/GraphQL/Execute.hs index 6fe8fd2fd07c2..d6963ac9e0998 100644 --- a/server/src-lib/Hasura/GraphQL/Execute.hs +++ b/server/src-lib/Hasura/GraphQL/Execute.hs @@ -354,8 +354,7 @@ getSubsOpM pgExecCtx initialReusability fld actionExecuter = _ -> do (astUnresolved, finalReusability) <- runReusabilityTWith initialReusability $ GR.queryFldToPGAST fld actionExecuter - let varTypes = finalReusability ^? _Reusable - EL.buildLiveQueryPlan pgExecCtx (VQ._fAlias fld) astUnresolved varTypes + EL.buildLiveQueryPlan pgExecCtx (VQ._fAlias fld) astUnresolved finalReusability getSubsOp :: ( MonadError QErr m diff --git a/server/src-lib/Hasura/GraphQL/Execute/LiveQuery/Plan.hs b/server/src-lib/Hasura/GraphQL/Execute/LiveQuery/Plan.hs index 9f446230d1e57..314b5928a3d5f 100644 --- a/server/src-lib/Hasura/GraphQL/Execute/LiveQuery/Plan.hs +++ b/server/src-lib/Hasura/GraphQL/Execute/LiveQuery/Plan.hs @@ -46,6 +46,7 @@ import Data.UUID (UUID) import qualified Hasura.GraphQL.Resolve as GR import qualified Hasura.GraphQL.Transport.HTTP.Protocol as GH import qualified Hasura.GraphQL.Validate as GV +import Hasura.GraphQL.Validate.Types (QueryReusability(..)) import qualified Hasura.SQL.DML as S import Hasura.Db @@ -254,7 +255,7 @@ buildLiveQueryPlan => PGExecCtx -> G.Alias -> GR.QueryRootFldUnresolved - -> Maybe GV.ReusableVariableTypes + -> QueryReusability -> m (LiveQueryPlan, Maybe ReusableLiveQueryPlan) buildLiveQueryPlan pgExecCtx fieldAlias astUnresolved varTypes = do userInfo <- asks getter @@ -273,7 +274,11 @@ buildLiveQueryPlan pgExecCtx fieldAlias astUnresolved varTypes = do validatedSyntheticVars <- validateVariables pgExecCtx (toList syntheticVariableValues) let cohortVariables = CohortVariables (_uiSession userInfo) validatedQueryVars validatedSyntheticVars plan = LiveQueryPlan parameterizedPlan cohortVariables - reusablePlan = ReusableLiveQueryPlan parameterizedPlan validatedSyntheticVars <$> varTypes + reusablePlan = + case varTypes of + Reusable types -> + Just $ ReusableLiveQueryPlan parameterizedPlan validatedSyntheticVars types + NotReusable -> Nothing pure (plan, reusablePlan) reuseLiveQueryPlan diff --git a/server/src-lib/Hasura/GraphQL/Execute/Query.hs b/server/src-lib/Hasura/GraphQL/Execute/Query.hs index 49098984c2e88..1c7c2ff3ee626 100644 --- a/server/src-lib/Hasura/GraphQL/Execute/Query.hs +++ b/server/src-lib/Hasura/GraphQL/Execute/Query.hs @@ -15,7 +15,6 @@ import qualified Data.TByteString as TBS import qualified Database.PG.Query as Q import qualified Language.GraphQL.Draft.Syntax as G -import Control.Lens ((^?)) import Data.Has import qualified Hasura.GraphQL.Resolve as R @@ -208,8 +207,10 @@ convertQuerySelSet initialReusability fields actionRunner = do R.traverseQueryRootFldAST prepareWithPlan unresolvedAst pure . RFPPostgres $ PGPlan (R.toPGQuery q) vars prepped pure (V._fAlias fld, fldPlan) - let varTypes = finalReusability ^? _Reusable - reusablePlan = ReusableQueryPlan <$> varTypes <*> pure fldPlans + let reusablePlan = + case finalReusability of + Reusable varTypes -> Just $ ReusableQueryPlan varTypes fldPlans + NotReusable -> Nothing (tx, sql) <- mkCurPlanTx usrVars fldPlans pure (tx, reusablePlan, sql) diff --git a/server/src-lib/Hasura/GraphQL/Resolve.hs b/server/src-lib/Hasura/GraphQL/Resolve.hs index 8b4351ee1f4c0..954b1bed9d0f5 100644 --- a/server/src-lib/Hasura/GraphQL/Resolve.hs +++ b/server/src-lib/Hasura/GraphQL/Resolve.hs @@ -38,6 +38,7 @@ import qualified Hasura.GraphQL.Resolve.Introspect as RIntro import qualified Hasura.GraphQL.Resolve.Mutation as RM import qualified Hasura.GraphQL.Resolve.Select as RS import qualified Hasura.GraphQL.Validate as V +import Hasura.GraphQL.Validate.Types (MonadReusability, markNotReusable) import qualified Hasura.RQL.DML.Select as DS import qualified Hasura.SQL.DML as S diff --git a/server/src-lib/Hasura/GraphQL/Resolve/Types.hs b/server/src-lib/Hasura/GraphQL/Resolve/Types.hs index 6a4de50943945..dbee10f26f668 100644 --- a/server/src-lib/Hasura/GraphQL/Resolve/Types.hs +++ b/server/src-lib/Hasura/GraphQL/Resolve/Types.hs @@ -1,7 +1,5 @@ module Hasura.GraphQL.Resolve.Types ( module Hasura.GraphQL.Resolve.Types - -- * Re-exports - , MonadReusability(..) ) where import Control.Lens.TH @@ -12,7 +10,6 @@ import qualified Data.Sequence as Seq import qualified Data.Text as T import qualified Language.GraphQL.Draft.Syntax as G -import Hasura.GraphQL.Validate.Types import Hasura.RQL.DDL.Headers (HeaderConf) import Hasura.RQL.Types.Action import Hasura.RQL.Types.BoolExp diff --git a/server/src-lib/Hasura/GraphQL/Validate/Types.hs b/server/src-lib/Hasura/GraphQL/Validate/Types.hs index 83c7e8261867e..bf160e6d13fef 100644 --- a/server/src-lib/Hasura/GraphQL/Validate/Types.hs +++ b/server/src-lib/Hasura/GraphQL/Validate/Types.hs @@ -71,10 +71,10 @@ module Hasura.GraphQL.Validate.Types , ReusableVariableValues , QueryReusability(..) - , _Reusable - , _NotReusable - , MonadReusability(..) + , MonadReusability , ReusabilityT + , markNotReusable + , recordVariableUse , runReusabilityT , runReusabilityTWith , evalReusabilityT @@ -95,8 +95,6 @@ import qualified Language.GraphQL.Draft.Syntax as G import qualified Language.GraphQL.Draft.TH as G import qualified Language.Haskell.TH.Syntax as TH -import Control.Lens (makePrisms) - import qualified Hasura.RQL.Types.Column as RQL import Hasura.GraphQL.Utils @@ -247,9 +245,6 @@ instance EquatableGType ObjTyInfo where (G.NamedType, Set.HashSet G.NamedType, Map.HashMap G.Name (G.Name, G.GType, ParamMap)) getEqProps a = (,,) (_otiName a) (_otiImplIFaces a) (Map.map getEqProps (_otiFields a)) -instance Monoid ObjTyInfo where - mempty = ObjTyInfo Nothing (G.NamedType "") Set.empty Map.empty - instance Semigroup ObjTyInfo where objA <> objB = objA { _otiFields = Map.union (_otiFields objA) (_otiFields objB) @@ -303,14 +298,6 @@ instance EquatableGType IFaceTyInfo where (G.NamedType, Map.HashMap G.Name (G.Name, G.GType, ParamMap)) getEqProps a = (,) (_ifName a) (Map.map getEqProps (_ifFields a)) -instance Monoid IFaceTyInfo where - mempty = IFaceTyInfo Nothing (G.NamedType "") Map.empty - -instance Semigroup IFaceTyInfo where - objA <> objB = - objA { _ifFields = Map.union (_ifFields objA) (_ifFields objB) - } - fromIFaceDef :: G.InterfaceTypeDefinition -> TypeLoc -> IFaceTyInfo fromIFaceDef (G.InterfaceTypeDefinition descM n _ flds) loc = mkIFaceTyInfo descM (G.NamedType n) fldMap loc @@ -331,14 +318,6 @@ instance EquatableGType UnionTyInfo where (G.NamedType, Set.HashSet G.NamedType) getEqProps a = (,) (_utiName a) (_utiMemberTypes a) -instance Monoid UnionTyInfo where - mempty = UnionTyInfo Nothing (G.NamedType "") Set.empty - -instance Semigroup UnionTyInfo where - objA <> objB = - objA { _utiMemberTypes = Set.union (_utiMemberTypes objA) (_utiMemberTypes objB) - } - fromUnionTyDef :: G.UnionTypeDefinition -> UnionTyInfo fromUnionTyDef (G.UnionTypeDefinition descM n _ mt) = UnionTyInfo descM (G.NamedType n) $ Set.fromList mt @@ -810,36 +789,28 @@ data QueryReusability = Reusable !ReusableVariableTypes | NotReusable deriving (Show, Eq) -$(makePrisms ''QueryReusability) - -instance Semigroup QueryReusability where - Reusable a <> Reusable b = Reusable (a <> b) - _ <> _ = NotReusable -instance Monoid QueryReusability where - mempty = Reusable mempty -class (Monad m) => MonadReusability m where - recordVariableUse :: G.Variable -> RQL.PGColumnType -> m () - markNotReusable :: m () +type MonadReusability m = MonadState QueryReusability m -instance (MonadReusability m) => MonadReusability (ReaderT r m) where - recordVariableUse a b = lift $ recordVariableUse a b - markNotReusable = lift markNotReusable +type ReusabilityT m a = StateT QueryReusability m a -newtype ReusabilityT m a = ReusabilityT { unReusabilityT :: StateT QueryReusability m a } - deriving (Functor, Applicative, Monad, MonadError e, MonadReader r, MonadIO) +markNotReusable :: MonadReusability m => m () +markNotReusable = put NotReusable -instance (Monad m) => MonadReusability (ReusabilityT m) where - recordVariableUse varName varType = ReusabilityT $ - modify' (<> Reusable (ReusableVariableTypes $ Map.singleton varName varType)) - markNotReusable = ReusabilityT $ put NotReusable +recordVariableUse :: MonadReusability m => G.Variable -> RQL.PGColumnType -> m () +recordVariableUse varName varType = modify' combine + where + combine :: QueryReusability -> QueryReusability + combine (Reusable (ReusableVariableTypes ts)) = + Reusable (ReusableVariableTypes (Map.insert varName varType ts)) + combine NotReusable = NotReusable runReusabilityT :: ReusabilityT m a -> m (a, QueryReusability) -runReusabilityT = runReusabilityTWith mempty +runReusabilityT = runReusabilityTWith (Reusable mempty) -- | Like 'runReusabilityT', but starting from an existing 'QueryReusability' state. runReusabilityTWith :: QueryReusability -> ReusabilityT m a -> m (a, QueryReusability) -runReusabilityTWith initialReusability = flip runStateT initialReusability . unReusabilityT +runReusabilityTWith initialReusability = flip runStateT initialReusability evalReusabilityT :: (Monad m) => ReusabilityT m a -> m a -evalReusabilityT = flip evalStateT mempty . unReusabilityT +evalReusabilityT = flip evalStateT (Reusable mempty)