graphql-engine/server/src-lib/Hasura/RQL/GBoolExp.hs
Vamshi Surabhi 47dcae1614
fix sql generation for boolean expressions, closes #853 (#1037)
When using self referential relationships in boolean expressions, the exists clause incorrectly uses the table names to qualify columns which will be the same for parent table and the child table. This is now fixed by generating unique aliases as we traverse down the relationships.
2018-11-16 18:10:23 +05:30

316 lines
9.9 KiB
Haskell

{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeSynonymInstances #-}
module Hasura.RQL.GBoolExp
( toSQLBoolExp
, getBoolExpDeps
, annBoolExp
, txtRHSBuilder
, pgValParser
) where
import Hasura.Prelude
import Hasura.RQL.Types
import Hasura.SQL.Types
import Hasura.SQL.Value
import qualified Hasura.SQL.DML as S
import Data.Aeson
import qualified Data.HashMap.Strict as M
import qualified Data.Text.Extended as T
parseOpExp
:: (MonadError QErr m)
=> ValueParser m a
-> FieldInfoMap
-> PGColInfo
-> (T.Text, Value) -> m (OpExpG a)
parseOpExp parser fim (PGColInfo cn colTy _) (opStr, val) = case opStr of
"$eq" -> parseEq
"_eq" -> parseEq
"$ne" -> parseNe
"_ne" -> parseNe
"$neq" -> parseNe
"_neq" -> parseNe
"$in" -> parseIn
"_in" -> parseIn
"$nin" -> parseNin
"_nin" -> parseNin
"$gt" -> parseGt
"_gt" -> parseGt
"$lt" -> parseLt
"_lt" -> parseLt
"$gte" -> parseGte
"_gte" -> parseGte
"$lte" -> parseLte
"_lte" -> parseLte
"$like" -> parseLike
"_like" -> parseLike
"$nlike" -> parseNlike
"_nlike" -> parseNlike
"$ilike" -> parseIlike
"_ilike" -> parseIlike
"$nilike" -> parseNilike
"_nilike" -> parseNilike
"$similar" -> parseSimilar
"_similar" -> parseSimilar
"$nsimilar" -> parseNsimilar
"_nsimilar" -> parseNsimilar
"$is_null" -> parseIsNull
"_is_null" -> parseIsNull
"$ceq" -> parseCeq
"_ceq" -> parseCeq
"$cne" -> parseCne
"_cne" -> parseCne
"$cneq" -> parseCne
"_cneq" -> parseCne
"$cgt" -> parseCgt
"_cgt" -> parseCgt
"$clt" -> parseClt
"_clt" -> parseClt
"$cgte" -> parseCgte
"_cgte" -> parseCgte
"$clte" -> parseClte
"_clte" -> parseClte
x -> throw400 UnexpectedPayload $ "Unknown operator : " <> x
where
parseEq = AEQ <$> parseOne -- equals
parseNe = ANE <$> parseOne -- <>
parseIn = AIN <$> parseMany -- in an array
parseNin = ANIN <$> parseMany -- not in an array
parseGt = AGT <$> parseOne -- >
parseLt = ALT <$> parseOne -- <
parseGte = AGTE <$> parseOne -- >=
parseLte = ALTE <$> parseOne -- <=
parseLike = textOnlyOp colTy >> ALIKE <$> parseOne
parseNlike = textOnlyOp colTy >> ANLIKE <$> parseOne
parseIlike = textOnlyOp colTy >> AILIKE <$> parseOne
parseNilike = textOnlyOp colTy >> ANILIKE <$> parseOne
parseSimilar = textOnlyOp colTy >> ASIMILAR <$> parseOne
parseNsimilar = textOnlyOp colTy >> ANSIMILAR <$> parseOne
parseIsNull = bool ANISNOTNULL ANISNULL -- is null
<$> decodeValue val
parseCeq = CEQ <$> decodeAndValidateRhsCol
parseCne = CNE <$> decodeAndValidateRhsCol
parseCgt = CGT <$> decodeAndValidateRhsCol
parseClt = CLT <$> decodeAndValidateRhsCol
parseCgte = CGTE <$> decodeAndValidateRhsCol
parseClte = CLTE <$> decodeAndValidateRhsCol
decodeAndValidateRhsCol =
decodeValue val >>= validateRhsCol
validateRhsCol rhsCol = do
let errMsg = "column operators can only compare postgres columns"
rhsType <- askPGType fim rhsCol errMsg
if colTy /= rhsType
then throw400 UnexpectedPayload $
"incompatible column types : " <> cn <<> ", " <>> rhsCol
else return rhsCol
parseOne = parser colTy val
parseMany = do
vals <- runAesonParser parseJSON val
indexedForM vals (parser colTy)
parseOpExps
:: (MonadError QErr m)
=> ValueParser m a
-> FieldInfoMap
-> PGColInfo
-> Value
-> m [OpExpG a]
parseOpExps valParser cim colInfo = \case
(Object o) -> mapM (parseOpExp valParser cim colInfo)(M.toList o)
val -> pure . AEQ <$> valParser (pgiType colInfo) val
type ValueParser m a = PGColType -> Value -> m a
buildMsg :: PGColType -> [PGColType] -> QErr
buildMsg ty expTys =
err400 UnexpectedPayload $ mconcat
[ " is of type " <> T.pack (show ty)
, "; this operator works "
, "only on columns of type "
, T.intercalate "/" $ map (T.dquote . T.pack . show) expTys
]
textOnlyOp :: (MonadError QErr m) => PGColType -> m ()
textOnlyOp PGText = return ()
textOnlyOp PGVarchar = return ()
textOnlyOp ty =
throwError $ buildMsg ty [PGVarchar, PGText]
-- This convoluted expression instead of col = val
-- to handle the case of col : null
equalsBoolExpBuilder :: S.SQLExp -> S.SQLExp -> S.BoolExp
equalsBoolExpBuilder qualColExp rhsExp =
S.BEBin S.OrOp (S.BECompare S.SEQ qualColExp rhsExp)
(S.BEBin S.AndOp
(S.BENull qualColExp)
(S.BENull rhsExp))
notEqualsBoolExpBuilder :: S.SQLExp -> S.SQLExp -> S.BoolExp
notEqualsBoolExpBuilder qualColExp rhsExp =
S.BEBin S.OrOp (S.BECompare S.SNE qualColExp rhsExp)
(S.BEBin S.AndOp
(S.BENotNull qualColExp)
(S.BENull rhsExp))
annBoolExp
:: (QErrM m, CacheRM m)
=> ValueParser m a
-> FieldInfoMap
-> BoolExp
-> m (AnnBoolExp a)
annBoolExp valParser fim (BoolExp boolExp) =
traverse (annColExp valParser fim) boolExp
annColExp
:: (QErrM m, CacheRM m)
=> ValueParser m a
-> FieldInfoMap
-> ColExp
-> m (AnnBoolExpFld a)
annColExp valueParser colInfoMap (ColExp fieldName colVal) = do
colInfo <- askFieldInfo colInfoMap fieldName
case colInfo of
FIColumn (PGColInfo _ PGJSON _) ->
throwError (err400 UnexpectedPayload "JSON column can not be part of where clause")
FIColumn (PGColInfo _ PGJSONB _) ->
throwError (err400 UnexpectedPayload "JSONB column can not be part of where clause")
FIColumn pgi ->
AVCol pgi <$> parseOpExps valueParser colInfoMap pgi colVal
FIRelationship relInfo -> do
relBoolExp <- decodeValue colVal
relFieldInfoMap <- askFieldInfoMap $ riRTable relInfo
annRelBoolExp <- annBoolExp valueParser relFieldInfoMap relBoolExp
return $ AVRel relInfo annRelBoolExp
toSQLBoolExp
:: S.Qual -> AnnBoolExpSQL -> S.BoolExp
toSQLBoolExp tq e =
evalState (convBoolRhs' tq e) 0
convBoolRhs'
:: S.Qual -> AnnBoolExpSQL -> State Word64 S.BoolExp
convBoolRhs' tq =
foldBoolExp (convColRhs tq)
convColRhs
:: S.Qual -> AnnBoolExpFldSQL -> State Word64 S.BoolExp
convColRhs tableQual = \case
AVCol (PGColInfo cn _ _) opExps -> do
let bExps = map (mkColCompExp tableQual cn) opExps
return $ foldr (S.BEBin S.AndOp) (S.BELit True) bExps
AVRel (RelInfo _ _ colMapping relTN _) nesAnn -> do
-- Convert the where clause on the relationship
curVarNum <- get
put $ curVarNum + 1
let newIden = Iden $ "_be_" <> T.pack (show curVarNum) <> "_"
<> snakeCaseTable relTN
newIdenQ = S.QualIden newIden
annRelBoolExp <- convBoolRhs' newIdenQ nesAnn
let backCompExp = foldr (S.BEBin S.AndOp) (S.BELit True) $
flip map colMapping $ \(lCol, rCol) ->
S.BECompare S.SEQ
(mkQCol (S.QualIden newIden) rCol)
(mkQCol tableQual lCol)
innerBoolExp = S.BEBin S.AndOp backCompExp annRelBoolExp
return $ S.mkExists (S.FISimple relTN $ Just $ S.Alias newIden) innerBoolExp
where
mkQCol q = S.SEQIden . S.QIden q . toIden
pgValParser
:: (MonadError QErr m)
=> PGColType -> Value -> m PGColValue
pgValParser ty =
runAesonParser (parsePGValue ty)
txtRHSBuilder
:: (MonadError QErr m)
=> PGColType -> Value -> m S.SQLExp
txtRHSBuilder ty val =
txtEncoder <$> pgValParser ty val
mkColCompExp
:: S.Qual -> PGCol -> OpExpG S.SQLExp -> S.BoolExp
mkColCompExp qual lhsCol = \case
AEQ val -> equalsBoolExpBuilder lhs val
ANE val -> notEqualsBoolExpBuilder lhs val
AIN vals -> S.BEEqualsAny lhs vals
ANIN vals -> S.BENot $ S.BEEqualsAny lhs vals
AGT val -> S.BECompare S.SGT lhs val
ALT val -> S.BECompare S.SLT lhs val
AGTE val -> S.BECompare S.SGTE lhs val
ALTE val -> S.BECompare S.SLTE lhs val
ALIKE val -> S.BECompare S.SLIKE lhs val
ANLIKE val -> S.BECompare S.SNLIKE lhs val
AILIKE val -> S.BECompare S.SILIKE lhs val
ANILIKE val -> S.BECompare S.SNILIKE lhs val
ASIMILAR val -> S.BECompare S.SSIMILAR lhs val
ANSIMILAR val -> S.BECompare S.SNSIMILAR lhs val
AContains val -> S.BECompare S.SContains lhs val
AContainedIn val -> S.BECompare S.SContainedIn lhs val
AHasKey val -> S.BECompare S.SHasKey lhs val
AHasKeysAny keys -> S.BECompare S.SHasKeysAny lhs $ toTextArray keys
AHasKeysAll keys -> S.BECompare S.SHasKeysAll lhs $ toTextArray keys
ANISNULL -> S.BENull lhs
ANISNOTNULL -> S.BENotNull lhs
CEQ rhsCol -> S.BECompare S.SEQ lhs $ mkQCol rhsCol
CNE rhsCol -> S.BECompare S.SNE lhs $ mkQCol rhsCol
CGT rhsCol -> S.BECompare S.SGT lhs $ mkQCol rhsCol
CLT rhsCol -> S.BECompare S.SLT lhs $ mkQCol rhsCol
CGTE rhsCol -> S.BECompare S.SGTE lhs $ mkQCol rhsCol
CLTE rhsCol -> S.BECompare S.SLTE lhs $ mkQCol rhsCol
where
mkQCol = S.SEQIden . S.QIden qual . toIden
lhs = mkQCol lhsCol
toTextArray arr =
S.SETyAnn (S.SEArray $ map (txtEncoder . PGValText) arr) S.textArrType
getColExpDeps :: QualifiedTable -> AnnBoolExpFld a -> [SchemaDependency]
getColExpDeps tn = \case
AVCol colInfo _ ->
let cn = pgiName colInfo
in [SchemaDependency (SOTableObj tn (TOCol cn)) "on_type"]
AVRel relInfo relBoolExp ->
let rn = riName relInfo
relTN = riRTable relInfo
pd = SchemaDependency (SOTableObj tn (TORel rn)) "on_type"
in pd : getBoolExpDeps relTN relBoolExp
getBoolExpDeps :: QualifiedTable -> AnnBoolExp a -> [SchemaDependency]
getBoolExpDeps tn =
foldr (\annFld deps -> getColExpDeps tn annFld <> deps) []