Add missing tests for NOT IN accepting empty values and refactor

Go back to operators map since the previously defined
Operator constructors added innecesary complexity also
rename Path to EmbedPath

src/PostgREST/DbRequestBuilder.hs

@@ -180,7 +180,7 @@ addFiltersOrdersRanges apiRequest = foldr1 (liftA2 (.)) [
   of type (ReadRequest->ReadRequest) that are in (Either ParseError a) context
   -}
   where
-    filters :: Either ApiRequestError [(Path, Filter)]
+    filters :: Either ApiRequestError [(EmbedPath, Filter)]
     filters = mapM pRequestFilter flts
       where
         action = iAction apiRequest
@@ -188,30 +188,30 @@ addFiltersOrdersRanges apiRequest = foldr1 (liftA2 (.)) [
           | action == ActionRead = iFilters apiRequest
           | action == ActionInvoke = iFilters apiRequest
           | otherwise = filter (( "." `isInfixOf` ) . fst) $ iFilters apiRequest -- there can be no filters on the root table whre we are doing insert/update
-    orders :: Either ApiRequestError [(Path, [OrderTerm])]
+    orders :: Either ApiRequestError [(EmbedPath, [OrderTerm])]
     orders = mapM pRequestOrder $ iOrder apiRequest
-    ranges :: Either ApiRequestError [(Path, NonnegRange)]
+    ranges :: Either ApiRequestError [(EmbedPath, NonnegRange)]
     ranges = mapM pRequestRange $ M.toList $ iRange apiRequest
 
 addFilterToNode :: Filter -> ReadRequest -> ReadRequest
 addFilterToNode flt (Node (q@Select {flt_=flts}, i) f) = Node (q {flt_=flt:flts}, i) f
 
-addFilter :: (Path, Filter) -> ReadRequest -> ReadRequest
+addFilter :: (EmbedPath, Filter) -> ReadRequest -> ReadRequest
 addFilter = addProperty addFilterToNode
 
 addOrderToNode :: [OrderTerm] -> ReadRequest -> ReadRequest
 addOrderToNode o (Node (q,i) f) = Node (q{order=Just o}, i) f
 
-addOrder :: (Path, [OrderTerm]) -> ReadRequest -> ReadRequest
+addOrder :: (EmbedPath, [OrderTerm]) -> ReadRequest -> ReadRequest
 addOrder = addProperty addOrderToNode
 
 addRangeToNode :: NonnegRange -> ReadRequest -> ReadRequest
 addRangeToNode r (Node (q,i) f) = Node (q{range_=r}, i) f
 
-addRange :: (Path, NonnegRange) -> ReadRequest -> ReadRequest
+addRange :: (EmbedPath, NonnegRange) -> ReadRequest -> ReadRequest
 addRange = addProperty addRangeToNode
 
-addProperty :: (a -> ReadRequest -> ReadRequest) -> (Path, a) -> ReadRequest -> ReadRequest
+addProperty :: (a -> ReadRequest -> ReadRequest) -> (EmbedPath, a) -> ReadRequest -> ReadRequest
 addProperty f ([], a) n = f a n
 addProperty f (path, a) (Node rn forest) =
   case targetNode of

src/PostgREST/OpenAPI.hs

@@ -8,11 +8,12 @@ module PostgREST.OpenAPI (
 
 import           Control.Lens
 import           Data.Aeson                  (decode, encode)
+import qualified Data.HashMap.Strict         as M
 import           Data.HashMap.Strict.InsOrd  (InsOrdHashMap, fromList)
 import           Data.Maybe                  (fromJust)
+import qualified Data.Set                    as Set
 import           Data.String                 (IsString (..))
 import           Data.Text                   (unpack, pack, concat, intercalate, init, tail, toLower)
-import qualified Data.Set                    as Set
 import           Network.URI                 (parseURI, isAbsoluteURI,
                                               URI (..), URIAuth (..))
 
@@ -23,7 +24,7 @@ import           Data.Swagger
 import           PostgREST.ApiRequest        (ContentType(..))
 import           PostgREST.Config            (prettyVersion)
 import           PostgREST.Types             (Table(..), Column(..), PgArg(..),
-                                              Proxy(..), ProcDescription(..), toMime, Operator(..))
+                                              Proxy(..), ProcDescription(..), toMime, operators)
 
 makeMimeList :: [ContentType] -> MimeList
 makeMimeList cs = MimeList $ map (fromString . toS . toMime) cs
@@ -72,7 +73,7 @@ makeOperatorPattern =
   intercalate "|"
   [ concat ["^", x, y, "[.]"] |
     x <- ["not[.]", ""],
-    y <- map show [Equals ..] ]
+    y <- M.keys operators ]
 
 makeRowFilter :: Column -> Param
 makeRowFilter c =

src/PostgREST/Parsers.hs

@@ -1,23 +1,23 @@
 module PostgREST.Parsers where
 
 import           Protolude                     hiding (try, intercalate)
-import           Control.Monad                ((>>))
+import           Control.Monad                 ((>>))
-import           Data.Foldable                (foldl1)
+import           Data.Foldable                 (foldl1)
+import qualified Data.HashMap.Strict           as M
 import           Data.Text                     (intercalate, replace, strip)
 import           Data.List                     (init, last)
 import           Data.Tree
 import           Data.Either.Combinators       (mapLeft)
+import           PostgREST.RangeQuery          (NonnegRange,allRange)
 import           PostgREST.Types
 import           Text.ParserCombinators.Parsec hiding (many, (<|>))
-import           Text.Read                    (read)
-import           PostgREST.RangeQuery      (NonnegRange,allRange)
 import           Text.Parsec.Error
 
 pRequestSelect :: Text -> Text -> Either ApiRequestError ReadRequest
 pRequestSelect rootName selStr =
   mapError $ parse (pReadRequest rootName) ("failed to parse select parameter (" <> toS selStr <> ")") (toS selStr)
 
-pRequestFilter :: (Text, Text) -> Either ApiRequestError (Path, Filter)
+pRequestFilter :: (Text, Text) -> Either ApiRequestError (EmbedPath, Filter)
 pRequestFilter (k, v) = mapError $ (,) <$> path <*> (Filter <$> fld <*> oper)
   where
     treePath = parse pTreePath ("failed to parser tree path (" ++ toS k ++ ")") $ toS k
@@ -25,14 +25,14 @@ pRequestFilter (k, v) = mapError $ (,) <$> path <*> (Filter <$> fld <*> oper)
     path = fst <$> treePath
     fld = snd <$> treePath
 
-pRequestOrder :: (Text, Text) -> Either ApiRequestError (Path, [OrderTerm])
+pRequestOrder :: (Text, Text) -> Either ApiRequestError (EmbedPath, [OrderTerm])
 pRequestOrder (k, v) = mapError $ (,) <$> path <*> ord'
   where
     treePath = parse pTreePath ("failed to parser tree path (" ++ toS k ++ ")") $ toS k
     path = fst <$> treePath
     ord' = parse pOrder ("failed to parse order (" ++ toS v ++ ")") $ toS v
 
-pRequestRange :: (ByteString, NonnegRange) -> Either ApiRequestError (Path, NonnegRange)
+pRequestRange :: (ByteString, NonnegRange) -> Either ApiRequestError (EmbedPath, NonnegRange)
 pRequestRange (k, v) = mapError $ (,) <$> path <*> pure v
   where
     treePath = parse pTreePath ("failed to parser tree path (" ++ toS k ++ ")") $ toS k
@@ -59,7 +59,7 @@ pReadRequest rootNodeName = do
             newForest =
               foldr treeEntry (Node (Select [] [fn] [] Nothing allRange, (fn, Nothing, alias)) []) fldForest:rForest
 
-pTreePath :: Parser (Path,Field)
+pTreePath :: Parser (EmbedPath, Field)
 pTreePath = do
   p <- pFieldName `sepBy1` pDelimiter
   jp <- optionMaybe pJsonPath
@@ -124,17 +124,17 @@ pOperation = try ( string "not" *> pDelimiter *> (Operation True <$> pExpr)) <|>
   where
     pExpr :: Parser (Operator, Operand)
     pExpr =
-          ((,) <$> (read <$> foldl1 (<|>) (try . string . show <$> notInOps)) <*> (pDelimiter *> pVText))
+          ((,) <$> (toS <$> foldl1 (<|>) (try . ((<* pDelimiter) . string) . toS <$> M.keys notInOps)) <*> pVText)
-      <|> try (string (show In) *> pDelimiter *> ((,) <$> pure In <*> pVTextL))
+      <|> ((,) <$> (toS <$> foldl1 (<|>) (try . ((<* pDelimiter) . string) . toS <$> M.keys inOps)) <*> pVTextL)
-      <|> try (string (show NotIn) *> pDelimiter *> ((,) <$> pure NotIn <*> pVTextL))
       <?> "operator (eq, gt, ...)"
-    notInOps = [Equals .. Contained]
+    inOps = M.filterWithKey (const . flip elem ["in", "notin"]) operators
+    notInOps = M.difference operators inOps
 
 pVText :: Parser Operand
 pVText = VText . toS <$> many anyChar
 
 pVTextL :: Parser Operand
-pVTextL = VTextL <$> pLValue `sepBy1` char ','
+pVTextL = VTextL <$> lexeme pLValue `sepBy1` char ','
   where
     pLValue :: Parser Text
     pLValue = toS <$> (try (char '"' *> many (noneOf "\"") <* char '"' <* notFollowedBy (noneOf ",") ) <|> many (noneOf ","))

src/PostgREST/QueryBuilder.hs

@@ -379,7 +379,7 @@ getJoinConditions (Relation t cols ft fcs typ lt lc1 lc2) =
     ftN = tableName ft
     ltN = fromMaybe "" (tableName <$> lt)
     toFilter :: Text -> Text -> Column -> Column -> Filter
-    toFilter tb ftb c fc = Filter (colName c, Nothing) (Operation False (Equals, VForeignKey (QualifiedIdentifier s tb) (ForeignKey fc{colTable=(colTable fc){tableName=ftb}})))
+    toFilter tb ftb c fc = Filter (colName c, Nothing) (Operation False ("=", VForeignKey (QualifiedIdentifier s tb) (ForeignKey fc{colTable=(colTable fc){tableName=ftb}})))
 
 unicodeStatement :: Text -> HE.Params a -> HD.Result b -> Bool -> H.Query a b
 unicodeStatement = H.statement . T.encodeUtf8
@@ -407,39 +407,37 @@ pgFmtSelectItem table (f@(_, jp), Nothing, alias) = pgFmtField table f <> pgFmtA
 pgFmtSelectItem table (f@(_, jp), Just cast, alias) = "CAST (" <> pgFmtField table f <> " AS " <> cast <> " )" <> pgFmtAs jp alias
 
 pgFmtFilter :: QualifiedIdentifier -> Filter -> SqlFragment
-pgFmtFilter table (Filter fld (Operation hasNot_ ex@(op, operand))) = notOp <> " " <> case operand of
+pgFmtFilter table (Filter fld (Operation hasNot_ ex)) = notOp <> " " <> case ex of
-  VForeignKey fQi (ForeignKey Column{colTable=Table{tableName=fTableName}, colName=fColName}) ->
+   (op, VText val) -> pgFmtFieldOp op <> " " <> case op of
-    pgFmtField fQi fld <> " " <> opToSqlFragment op <> " " <> pgFmtColumn (removeSourceCTESchema (qiSchema fQi) fTableName) fColName
+     "like"  -> unknownLiteral (T.map star val)
-  _ -> pgFmtField table fld <> " " <> pgFmtExpr ex
+     "ilike" -> unknownLiteral (T.map star val)
-  where
+     "@@"    -> "to_tsquery(" <> unknownLiteral val <> ") "
-    notOp = if hasNot_ then "NOT" else ""
+     "is"    -> whiteList val
-
+     "isnot" -> whiteList val
-pgFmtExpr :: (Operator, Operand) -> SqlFragment
+     _       -> unknownLiteral val
-pgFmtExpr ex =
+   (op, VTextL vals) -> pgFmtIn op vals -- in and notin
- case ex of
+   (op, VForeignKey fQi (ForeignKey Column{colTable=Table{tableName=fTableName}, colName=fColName})) ->
-   (Like, VText val)    -> opToSqlFragment Like <> " " <> unknownLiteral (T.map star val)
+     pgFmtField fQi fld <> " " <> sqlOperator op <> " " <> pgFmtColumn (removeSourceCTESchema (qiSchema fQi) fTableName) fColName
-   (ILike, VText val)   -> opToSqlFragment ILike <> " " <> unknownLiteral (T.map star val)
-   (TSearch, VText val) -> opToSqlFragment TSearch <> " " <> "to_tsquery(" <> unknownLiteral val <> ") "
-   (Is, VText val)      -> opToSqlFragment Is <> " " <> whiteList val
-   (In, VTextL vals)    -> exprForIn vals
-   (NotIn, VTextL vals) -> opToSqlFragment NotIn <> " " <> "(" <> intercalate ", " (map unknownLiteral vals) <> ") "
-   (op, VText val)      -> opToSqlFragment op <> " " <> unknownLiteral val
-   _ -> "" -- should not happen, all possible combinations are defined in Parsers
  where
+   pgFmtFieldOp op = pgFmtField table fld <> " " <> sqlOperator op
+   sqlOperator o = HM.lookupDefault "=" o operators
+   notOp = if hasNot_ then "NOT" else ""
    star c = if c == '*' then '%' else c
    unknownLiteral = (<> "::unknown ") . pgFmtLit
    whiteList :: Text -> SqlFragment
    whiteList v = fromMaybe
      (toS (pgFmtLit v) <> "::unknown ")
      (find ((==) . toLower $ v) ["null","true","false"])
-   exprForIn :: [Text] -> SqlFragment
+   pgFmtIn :: Operator -> [Text] -> SqlFragment
-   exprForIn vals =
+   pgFmtIn op vals =
-    let emptyValForIn = "= any('{}') " in
+    -- Workaround because for postgresql "col IN ()" is invalid syntax, we instead do "col = any('{}')"
+    let emptyValForIn o = (if "not" `isInfixOf` o then "NOT " else "") -- handle case of "notin" operator
+                          <> pgFmtField table fld <> " = any('{}') " in
     case T.null <$> headMay vals of
       Just isNull -> if isNull && length vals == 1
-                        then emptyValForIn
+                        then emptyValForIn op
-                        else opToSqlFragment In <> " " <> "(" <> intercalate ", " (map unknownLiteral vals) <> ") "
+                        else pgFmtFieldOp op <> "(" <> intercalate ", " (map unknownLiteral vals) <> ") "
-      Nothing -> emptyValForIn
+      Nothing -> emptyValForIn op
 
 pgFmtJsonPath :: Maybe JsonPath -> SqlFragment
 pgFmtJsonPath (Just [x]) = "->>" <> pgFmtLit x

src/PostgREST/Types.hs

@@ -1,10 +1,9 @@
 module PostgREST.Types where
 import           Protolude
 import qualified GHC.Show
-import qualified GHC.Read
 import           Data.Aeson
 import qualified Data.ByteString.Lazy as BL
-import           Data.HashMap.Strict  as M
+import qualified Data.HashMap.Strict  as M
 import           Data.Tree
 import qualified Data.Vector          as V
 import           PostgREST.RangeQuery (NonnegRange)
@@ -137,66 +136,27 @@ data Proxy = Proxy {
 , proxyPath       :: Text
 } deriving (Show, Eq)
 
-data Operator = Equals | Gte | Gt | Lte | Lt | Neq | Like | ILike | Is | IsNot |
+type Operator = Text
-                TSearch | Contains | Contained | In | NotIn deriving (Eq, Enum)
+operators :: M.HashMap Operator SqlFragment
-
+operators = M.fromList [
-instance Show Operator where
+  ("eq", "="),
-  show op =  case op of
+  ("gte", ">="),
-    Equals -> "eq"
+  ("gt", ">"),
-    Gte -> "gte"
+  ("lte", "<="),
-    Gt -> "gt"
+  ("lt", "<"),
-    Lte -> "lte"
+  ("neq", "<>"),
-    Lt -> "lt"
+  ("like", "LIKE"),
-    Neq -> "neq"
+  ("ilike", "ILIKE"),
-    Like -> "like"
+  ("in", "IN"),
-    ILike -> "ilike"
+  ("notin", "NOT IN"),
-    In -> "in"
+  ("isnot", "IS NOT"),
-    NotIn -> "notin"
+  ("is", "IS"),
-    IsNot -> "isnot"
+  ("@@", "@@"),
-    Is -> "is"
+  ("@>", "@>"),
-    TSearch -> "@@"
+  ("<@", "<@")]
-    Contains -> "@>"
-    Contained -> "<@"
-
-instance Read Operator where
-  readsPrec _ op =  case op of
-    "eq" -> [(Equals, "")]
-    "gte" -> [(Gte, "")]
-    "gt" -> [(Gt, "")]
-    "lte" -> [(Lte, "")]
-    "lt" -> [(Lt, "")]
-    "neq" -> [(Neq, "")]
-    "like" -> [(Like, "")]
-    "ilike" -> [(ILike, "")]
-    "in" -> [(In, "")]
-    "notin" -> [(NotIn, "")]
-    "isnot" -> [(IsNot, "")]
-    "is" -> [(Is, "")]
-    "@@" -> [(TSearch, "")]
-    "@>" -> [(Contains, "")]
-    "<@" -> [(Contained, "")]
-    _ -> []
-
-opToSqlFragment :: Operator -> SqlFragment
-opToSqlFragment op = case op of
-  Equals -> "="
-  Gte -> ">="
-  Gt -> ">"
-  Lte -> "<="
-  Lt -> "<"
-  Neq -> "<>"
-  Like -> "LIKE"
-  ILike -> "ILIKE"
-  In -> "IN"
-  NotIn -> "NOT IN"
-  IsNot -> "IS NOT"
-  Is -> "IS"
-  TSearch -> "@@"
-  Contains -> "@>"
-  Contained -> "<@"
-
 data Operation = Operation{ hasNot::Bool, expr::(Operator, Operand) } deriving (Eq, Show)
 data Operand = VText Text | VTextL [Text] | VForeignKey QualifiedIdentifier ForeignKey deriving (Show, Eq)
+
 type FieldName = Text
 type JsonPath = [Text]
 type Field = (FieldName, Maybe JsonPath)
@@ -204,12 +164,14 @@ type Alias = Text
 type Cast = Text
 type NodeName = Text
 type SelectItem = (Field, Maybe Cast, Maybe Alias)
-type Path = [Text]
+-- | Path of the embedded levels, e.g "clients.projects.name=eq.." gives Path ["clients", "projects"]
+type EmbedPath = [Text]
+data Filter = Filter { field::Field, operation::Operation } deriving (Show, Eq)
+
 data ReadQuery = Select { select::[SelectItem], from::[TableName], flt_::[Filter], order::Maybe [OrderTerm], range_::NonnegRange } deriving (Show, Eq)
 data MutateQuery = Insert { in_::TableName, qPayload::PayloadJSON, returning::[FieldName] }
                  | Delete { in_::TableName, where_::[Filter], returning::[FieldName] }
                  | Update { in_::TableName, qPayload::PayloadJSON, where_::[Filter], returning::[FieldName] } deriving (Show, Eq)
-data Filter = Filter { field::Field, operation::Operation } deriving (Show, Eq)
 type ReadNode = (ReadQuery, (NodeName, Maybe Relation, Maybe Alias))
 type ReadRequest = Tree ReadNode
 type MutateRequest = MutateQuery

test/Feature/QuerySpec.hs

@@ -772,8 +772,8 @@ spec = do
       get "/w_or_wo_comma_names?name=in.Williams\"Hebdon, John\"" `shouldRespondWith`
         [json| [] |] { matchHeaders = [matchContentTypeJson] }
 
-  describe "IN empty set" $ do
+  describe "IN and NOT IN empty set" $ do
-    context "returns an empty result set when no value is present" $ do
+    context "returns an empty result for IN when no value is present" $ do
       it "works for integer" $
         get "/items_with_different_col_types?int_data=in." `shouldRespondWith`
           [json| [] |] { matchHeaders = [matchContentTypeJson] }
@@ -799,8 +799,17 @@ spec = do
         get "/items_with_different_col_types?time_data=in." `shouldRespondWith`
           [json| [] |] { matchHeaders = [matchContentTypeJson] }
 
+    it "returns all results for notin when no value is present" $
+      get "/items_with_different_col_types?int_data=notin.&select=int_data" `shouldRespondWith`
+        [json| [{int_data: 1}] |] { matchHeaders = [matchContentTypeJson] }
+
+    it "returns all results for not.in when no value is present" $
+      get "/items_with_different_col_types?int_data=not.in.&select=int_data" `shouldRespondWith`
+        [json| [{int_data: 1}] |] { matchHeaders = [matchContentTypeJson] }
+
     it "returns an empty result ignoring spaces" $
-      get "/items_with_different_col_types?int_data=in.    " `shouldRespondWith` 400
+      get "/items_with_different_col_types?int_data=in.    " `shouldRespondWith`
+        [json| [] |] { matchHeaders = [matchContentTypeJson] }
 
     it "only returns an empty result set if the in value is empty" $
       get "/items_with_different_col_types?int_data=in. ,3,4" `shouldRespondWith` 400

test/fixtures/data.sql

@@ -294,6 +294,9 @@ INSERT INTO w_or_wo_comma_names VALUES ('Smith, Joseph');
 INSERT INTO w_or_wo_comma_names VALUES ('David White');
 INSERT INTO w_or_wo_comma_names VALUES ('Larry Thompson');
 
+TRUNCATE TABLE items_with_different_col_types CASCADE;
+INSERT INTO items_with_different_col_types VALUES (1, null, null, null, null, null, null, null);
+
 --
 -- PostgreSQL database dump complete
 --