diff --git a/src/PostgREST/App.hs b/src/PostgREST/App.hs index b48b7db1b..1dd24b96b 100644 --- a/src/PostgREST/App.hs +++ b/src/PostgREST/App.hs @@ -20,7 +20,7 @@ import Data.List (find, sortBy, delete, transpose) import Data.Maybe (fromMaybe, fromJust, isJust, isNothing, mapMaybe) import Data.Ord (comparing) import Data.Ranged.Ranges (emptyRange) -import qualified Data.Set as S +--import qualified Data.Set as S import Data.String.Conversions (cs) import Data.Text (Text, replace, strip) import Data.Tree @@ -109,29 +109,29 @@ app dbstructure conf reqBody req = request = parseRequest schema (fakeSourceRelations ++ allRels) table req reqBody fakeSourceRelations = mapMaybe (toSourceRelation table) allRels - ([table], "PUT") -> - handleJsonObj reqBody $ \obj -> do - let qt = qualify table - pKeys = map pkName $ filter (filterPk schema table) allPrKeys - specifiedKeys = map (cs . fst) qq - if S.fromList pKeys /= S.fromList specifiedKeys - then return $ responseLBS status405 [] - "You must speficy all and only primary keys as params" - else do - let tableCols = map (cs . colName) $ filter (filterCol schema table) allCols - cols = map cs $ HM.keys obj - if S.fromList tableCols == S.fromList cols - then do - let vals = HM.elems obj - H.unitEx $ iffNotT - (whereT qt qq $ update qt cols vals) - (insertSelect qt cols vals) - return $ responseLBS status204 [ jsonH ] "" - - else return $ if Prelude.null tableCols - then responseLBS status404 [] "" - else responseLBS status400 [] - "You must specify all columns in PUT request" + -- ([table], "PUT") -> + -- handleJsonObj reqBody $ \obj -> do + -- let qt = qualify table + -- pKeys = map pkName $ filter (filterPk schema table) allPrKeys + -- specifiedKeys = map (cs . fst) qq + -- if S.fromList pKeys /= S.fromList specifiedKeys + -- then return $ responseLBS status405 [] + -- "You must speficy all and only primary keys as params" + -- else do + -- let tableCols = map (cs . colName) $ filter (filterCol schema table) allCols + -- cols = map cs $ HM.keys obj + -- if S.fromList tableCols == S.fromList cols + -- then do + -- let vals = HM.elems obj + -- H.unitEx $ iffNotT + -- (whereT qt qq $ update qt cols vals) + -- (insertSelect qt cols vals) + -- return $ responseLBS status204 [ jsonH ] "" + -- + -- else return $ if Prelude.null tableCols + -- then responseLBS status404 [] "" + -- else responseLBS status400 [] + -- "You must specify all columns in PUT request" ([table], "PATCH") -> do let echoRequested = hasPrefer "return=representation" @@ -153,16 +153,19 @@ app dbstructure conf reqBody req = fakeSourceRelations = mapMaybe (toSourceRelation table) allRels ([table], "DELETE") -> do - let qt = qualify table - del = countT - . returningStarT - . whereT qt qq - $ deleteFrom qt - row <- H.maybeEx del - let (Identity deletedCount) = fromMaybe (Identity 0 :: Identity Int) row - return $ if deletedCount == 0 - then responseLBS status404 [] "" - else responseLBS status204 [("Content-Range", "*/"<> cs (show deletedCount))] "" + case request of + Left e -> return $ responseLBS status400 [jsonH] $ cs e + Right (selectQuery, mutateQuery, _) -> do + let q = B.Stmt (createStatement selectQuery (Just (mutateQuery, False)) False Nothing [] True isCsv) V.empty True + row <- H.maybeEx q + let (_, queryTotal, _, _) = extractQueryResult row + return $ if queryTotal == 0 + then responseLBS status404 [] "" + else responseLBS status204 [("Content-Range", "*/"<> cs (show queryTotal))] "" + + + where + request = parseRequest schema allRels table req reqBody (["rpc", proc], "POST") -> do let qi = QualifiedIdentifier schema (cs proc) @@ -211,8 +214,8 @@ app dbstructure conf reqBody req = filterTableAcl r (Table{tableAcl=a}) = r `elem` a path = pathInfo req verb = requestMethod req - qq = queryString req - qualify = QualifiedIdentifier schema + --qq = queryString req + --qualify = QualifiedIdentifier schema hdrs = requestHeaders req lookupHeader = flip lookup hdrs hasPrefer val = any (\(h,v) -> h == "Prefer" && v == val) hdrs @@ -266,22 +269,22 @@ contentTypeForAccept accept findInAccept = flip find $ parseHttpAccept acceptH has = isJust . findInAccept . BS.isPrefixOf -handleJsonObj :: BL.ByteString -> (Object -> H.Tx P.Postgres s Response) - -> H.Tx P.Postgres s Response -handleJsonObj reqBody handler = do - let p = eitherDecode reqBody - case p of - Left err -> - return $ responseLBS status400 [jsonH] jErr - where - jErr = encode . object $ - [("message", String $ "Failed to parse JSON payload. " <> cs err)] - Right (Object o) -> handler o - Right _ -> - return $ responseLBS status400 [jsonH] jErr - where - jErr = encode . object $ - [("message", String "Expecting a JSON object")] +-- handleJsonObj :: BL.ByteString -> (Object -> H.Tx P.Postgres s Response) +-- -> H.Tx P.Postgres s Response +-- handleJsonObj reqBody handler = do +-- let p = eitherDecode reqBody +-- case p of +-- Left err -> +-- return $ responseLBS status400 [jsonH] jErr +-- where +-- jErr = encode . object $ +-- [("message", String $ "Failed to parse JSON payload. " <> cs err)] +-- Right (Object o) -> handler o +-- Right _ -> +-- return $ responseLBS status400 [jsonH] jErr +-- where +-- jErr = encode . object $ +-- [("message", String "Expecting a JSON object")] parseCsvCell :: BL.ByteString -> Value parseCsvCell s = if s == "NULL" then Null else String $ cs s @@ -428,11 +431,14 @@ parseRequest schema allRels rootTableName httpRequest reqBody = then M.fromList <$> (zip <$> flds <*> (head <$> vals)) else Left "Expecting a sigle CSV line with header or a JSON object" allFilters = whereFilters qParams - updateFilters = filter (not . ( '.' `elem` ) . fst) $ allFilters -- update filters can be only on the root table - cond = first formatParserError $ map snd <$> mapM pRequestFilter updateFilters + mutateFilters = filter (not . ( '.' `elem` ) . fst) $ allFilters -- update/delete filters can be only on the root table + cond = first formatParserError $ map snd <$> mapM pRequestFilter mutateFilters selectApiRequest = augumentRequestWithJoin schema allRels - =<< buildSelectApiRequest rootName (selectStr qParams) filters (orderStr qParams) + =<< buildSelectApiRequest rootName sel filters (orderStr qParams) where + sel = if method == "DELETE" + then "*" -- we are not returning the records so no need to consider nested items + else selectStr qParams rootName = if method == "GET" then rootTableName else sourceSubqueryName @@ -441,9 +447,10 @@ parseRequest schema allRels rootTableName httpRequest reqBody = else filter (( '.' `elem` ) . fst) allFilters -- there can be no filters on the root table whre we are doing insert/update selectQuery = requestToQuery schema <$> selectApiRequest mutateQuery = requestToQuery schema <$> case method of - "POST" -> (Node <$> ((,) <$> (Insert rootTableName <$> flds <*> vals) <*> pure (rootTableName, Nothing)) <*> pure []) - "PATCH" -> (Node <$> ((,) <$> (Update rootTableName <$> setWith <*> cond) <*> pure (rootTableName, Nothing)) <*> pure []) - _ -> undefined + "POST" -> (Node <$> ((,) <$> (Insert rootTableName <$> flds <*> vals) <*> pure (rootTableName, Nothing)) <*> pure []) + "PATCH" -> (Node <$> ((,) <$> (Update rootTableName <$> setWith <*> cond) <*> pure (rootTableName, Nothing)) <*> pure []) + "DELETE" -> (Node <$> ((,) <$> (Delete [rootTableName] <$> cond) <*> pure (rootTableName, Nothing)) <*> pure []) + _ -> undefined createStatement :: Text -> Maybe (Text, Bool) -> Bool -> Maybe NonnegRange -> [Text] -> Bool -> Bool -> Text createStatement selectQuery Nothing _ range _ countTable asCsv = diff --git a/src/PostgREST/MainTest.hs b/src/PostgREST/MainTest.hs new file mode 100644 index 000000000..89a2397c9 --- /dev/null +++ b/src/PostgREST/MainTest.hs @@ -0,0 +1,131 @@ +module Main where + + +import PostgREST.App +import PostgREST.Config (AppConfig (..), + minimumPgVersion, + prettyVersion, + readOptions) +import PostgREST.Error (errResponse, PgError) +import PostgREST.Middleware +import PostgREST.PgStructure +import PostgREST.Types + +import Control.Monad (unless) +import Control.Monad.IO.Class (liftIO) +import Data.Aeson (encode) +import Data.Functor.Identity +import Data.Monoid ((<>)) +import Data.String.Conversions (cs) +import Data.Text (Text) +import qualified Hasql as H +import qualified Hasql.Postgres as P +import Network.Wai +import Network.Wai.Handler.Warp hiding (Connection) +import Network.Wai.Middleware.RequestLogger (logStdout) +import System.IO (BufferMode (..), + hSetBuffering, stderr, + stdin, stdout) +-- import Data.Maybe (mapMaybe) +-- import Data.List (subsequences) +-- import Control.Monad (join) +-- import PostgREST.QueryBuilder +-- import GHC.Exts (groupWith) + + +isServerVersionSupported :: H.Session P.Postgres IO Bool +isServerVersionSupported = do + Identity (row :: Text) <- H.tx Nothing $ H.singleEx [H.stmt|SHOW server_version_num|] + return $ read (cs row) >= minimumPgVersion + +hasqlError :: PgError -> IO a +hasqlError = error . cs . encode + + +main :: IO () +main = do + hSetBuffering stdout LineBuffering + hSetBuffering stdin LineBuffering + hSetBuffering stderr NoBuffering + + -- let dbString = "postgres://postgrest_test@localhost:5432/postgrest_test" :: String + -- conf = AppConfig dbString 3000 "postgrest_anonymous" "test" False "safe" 10 :: AppConfig + + conf <- readOptions + let port = configPort conf + + unless (configSecure conf) $ + putStrLn "WARNING, running in insecure mode, auth will be in plaintext" + unless ("secret" /= configJwtSecret conf) $ + putStrLn "WARNING, running in insecure mode, JWT secret is the default value" + Prelude.putStrLn $ "Listening on port " ++ + (show $ configPort conf :: String) + + let pgSettings = P.StringSettings $ cs (configDatabase conf) + appSettings = setPort port + . setServerName (cs $ "postgrest/" <> prettyVersion) + $ defaultSettings + middle = logStdout . defaultMiddle (configSecure conf) + + poolSettings <- maybe (fail "Improper session settings") return $ + H.poolSettings (fromIntegral $ configPool conf) 30 + pool :: H.Pool P.Postgres <- H.acquirePool pgSettings poolSettings + + supportedOrError <- H.session pool isServerVersionSupported + either hasqlError + (\supported -> + unless supported $ + error ( + "Cannot run in this PostgreSQL version, PostgREST needs at least " + <> show minimumPgVersion) + ) supportedOrError + + -- what was this code for? + -- roleOrError <- H.session pool $ do + -- Identity (role :: Text) <- H.tx Nothing $ H.singleEx + -- [H.stmt|SELECT SESSION_USER|] + -- return role + -- authenticator <- either hasqlError return roleOrError + + let txSettings = Just (H.ReadCommitted, Just True) + metadata <- H.session pool $ H.tx txSettings $ do + tabs <- allTables + rels <- allRelations + cols <- allColumns rels + keys <- allPrimaryKeys + return (tabs, rels, cols, keys) + + + dbstructure <- either hasqlError + (\(tabs, rels, cols, keys) -> + + return DbStructure { + tables=tabs + , columns=cols + , relations=rels + , primaryKeys=keys + } + ) metadata + runSettings appSettings $ middle $ \ req respond -> do + body <- strictRequestBody req + resOrError <- liftIO $ H.session pool $ H.tx txSettings $ + runWithClaims conf (app dbstructure conf body) req + either (respond . errResponse) respond resOrError + + --let allRels = relations dbstructure + -- links = join $ map (combinations 2) $ filter ((>=1).length) $ groupWith groupFn $ filter ( (==Child). relType) allRels + -- combinations k ns = filter ((k==).length) (subsequences ns) + + --print $ findRelation allRels "test" "projects" "users" + --mapM_ print $ mapMaybe link2Relation links + + -- where + -- groupFn :: Relation -> Text + -- groupFn (Relation{relSchema=s, relTable=t}) = s<>"_"<>t + -- link2Relation [ + -- Relation{relSchema=sc, relTable=lt, relColumns=lc1, relFTable=t, relFColumns=c}, + -- Relation{ relColumns=lc2, relFTable=ft, relFColumns=fc} + -- ] + -- | lc1 /= lc2 && length lc1 == 1 && length lc2 == 1 = Just $ Relation sc t c ft fc Many (Just lt) (Just lc1) (Just lc2) + -- | otherwise = Nothing + -- link2Relation _ = Nothing diff --git a/src/PostgREST/PgQuery.hs b/src/PostgREST/PgQuery.hs index 3d25b2cd2..70247c9ac 100644 --- a/src/PostgREST/PgQuery.hs +++ b/src/PostgREST/PgQuery.hs @@ -9,12 +9,12 @@ module PostgREST.PgQuery ( , wrapQuery , asJson , callProc -, iffNotT -, update -, insertSelect -, deleteFrom -, asCsvWithCount -, asJsonWithCount +-- , iffNotT +-- , update +-- , insertSelect +-- , deleteFrom +-- , asCsvWithCount +-- , asJsonWithCount , unquoted -- format functions @@ -30,10 +30,10 @@ module PostgREST.PgQuery ( , pgFmtAsJsonPath -- query transformers (to be removed) -, withT -, countT -, returningStarT -, whereT +-- , withT +-- , countT +-- , returningStarT +-- , whereT -- query fragments , sourceSubqueryName @@ -70,7 +70,7 @@ import Data.Scientific (FPFormat (..), formatScientific, import Data.String.Conversions (cs) import qualified Data.Text as T import Data.Vector (empty) -import qualified Network.HTTP.Types.URI as Net +--import qualified Network.HTTP.Types.URI as Net import Text.Regex.TDFA ((=~)) import Prelude @@ -107,82 +107,82 @@ operators = M.fromList [ ] -whereT :: QualifiedIdentifier -> Net.Query -> StatementT -whereT table params q = - if L.null cols - then q - else q <> B.Stmt " where " empty True <> conjunction - where - cols = [ col | col <- params, fst col `notElem` ["order","select"] ] - wherePredTable = wherePred table - conjunction = mconcat $ L.intersperse andq (map wherePredTable cols) - -withT :: PStmt -> T.Text -> StatementT -withT (B.Stmt eq ep epre) v (B.Stmt wq wp wpre) = - B.Stmt ("WITH " <> v <> " AS (" <> eq <> ") " <> wq <> " from " <> v) - (ep <> wp) - (epre && wpre) - -iffNotT :: PStmt -> StatementT -iffNotT (B.Stmt aq ap apre) (B.Stmt bq bp bpre) = - B.Stmt - ("WITH aaa AS (" <> aq <> " returning *) " <> - bq <> " WHERE NOT EXISTS (SELECT * FROM aaa)") - (ap <> bp) - (apre && bpre) - -countT :: StatementT -countT s = - s { B.stmtTemplate = "WITH qqq AS (" <> B.stmtTemplate s <> ") SELECT pg_catalog.count(1) FROM qqq" } - -asCsvWithCount :: QualifiedIdentifier -> StatementT -asCsvWithCount table = withCount . asCsv table - -asCsv :: QualifiedIdentifier -> StatementT -asCsv table s = s { - B.stmtTemplate = - "(select string_agg(quote_ident(column_name::text), ',') from " - <> "(select column_name from information_schema.columns where quote_ident(table_schema) || '.' || table_name = '" - <> fromQi table <> "' order by ordinal_position) h) || '\r' || " - <> "coalesce(string_agg(substring(t::text, 2, length(t::text) - 2), '\r'), '') from (" - <> B.stmtTemplate s <> ") t" } - -asJsonWithCount :: StatementT -asJsonWithCount = withCount . asJson - +-- whereT :: QualifiedIdentifier -> Net.Query -> StatementT +-- whereT table params q = +-- if L.null cols +-- then q +-- else q <> B.Stmt " where " empty True <> conjunction +-- where +-- cols = [ col | col <- params, fst col `notElem` ["order","select"] ] +-- wherePredTable = wherePred table +-- conjunction = mconcat $ L.intersperse andq (map wherePredTable cols) +-- +-- withT :: PStmt -> T.Text -> StatementT +-- withT (B.Stmt eq ep epre) v (B.Stmt wq wp wpre) = +-- B.Stmt ("WITH " <> v <> " AS (" <> eq <> ") " <> wq <> " from " <> v) +-- (ep <> wp) +-- (epre && wpre) +-- +-- iffNotT :: PStmt -> StatementT +-- iffNotT (B.Stmt aq ap apre) (B.Stmt bq bp bpre) = +-- B.Stmt +-- ("WITH aaa AS (" <> aq <> " returning *) " <> +-- bq <> " WHERE NOT EXISTS (SELECT * FROM aaa)") +-- (ap <> bp) +-- (apre && bpre) +-- +-- countT :: StatementT +-- countT s = +-- s { B.stmtTemplate = "WITH qqq AS (" <> B.stmtTemplate s <> ") SELECT pg_catalog.count(1) FROM qqq" } +-- +-- asCsvWithCount :: QualifiedIdentifier -> StatementT +-- asCsvWithCount table = withCount . asCsv table +-- +-- asCsv :: QualifiedIdentifier -> StatementT +-- asCsv table s = s { +-- B.stmtTemplate = +-- "(select string_agg(quote_ident(column_name::text), ',') from " +-- <> "(select column_name from information_schema.columns where quote_ident(table_schema) || '.' || table_name = '" +-- <> fromQi table <> "' order by ordinal_position) h) || '\r' || " +-- <> "coalesce(string_agg(substring(t::text, 2, length(t::text) - 2), '\r'), '') from (" +-- <> B.stmtTemplate s <> ") t" } +-- +-- asJsonWithCount :: StatementT +-- asJsonWithCount = withCount . asJson +-- asJson :: StatementT asJson s = s { B.stmtTemplate = "array_to_json(array_agg(row_to_json(t)))::character varying from (" <> B.stmtTemplate s <> ") t" } - -withCount :: StatementT -withCount s = s { B.stmtTemplate = "pg_catalog.count(t), " <> B.stmtTemplate s } - -returningStarT :: StatementT -returningStarT s = s { B.stmtTemplate = B.stmtTemplate s <> " RETURNING *" } - -deleteFrom :: QualifiedIdentifier -> PStmt -deleteFrom t = B.Stmt ("delete from " <> fromQi t) empty True - -insertSelect :: QualifiedIdentifier -> [T.Text] -> [JSON.Value] -> PStmt -insertSelect t [] _ = B.Stmt - ("insert into " <> fromQi t <> " default values returning *") empty True -insertSelect t cols vals = B.Stmt - ("insert into " <> fromQi t <> " (" - <> T.intercalate ", " (map pgFmtIdent cols) - <> ") select " - <> T.intercalate ", " (map insertableValue vals)) - empty True - -update :: QualifiedIdentifier -> [T.Text] -> [JSON.Value] -> PStmt -update t cols vals = B.Stmt - ("update " <> fromQi t <> " set (" - <> T.intercalate ", " (map pgFmtIdent cols) - <> ") = (" - <> T.intercalate ", " (map insertableValue vals) - <> ")") - empty True +-- +-- withCount :: StatementT +-- withCount s = s { B.stmtTemplate = "pg_catalog.count(t), " <> B.stmtTemplate s } +-- +-- returningStarT :: StatementT +-- returningStarT s = s { B.stmtTemplate = B.stmtTemplate s <> " RETURNING *" } +-- +-- deleteFrom :: QualifiedIdentifier -> PStmt +-- deleteFrom t = B.Stmt ("delete from " <> fromQi t) empty True +-- +-- insertSelect :: QualifiedIdentifier -> [T.Text] -> [JSON.Value] -> PStmt +-- insertSelect t [] _ = B.Stmt +-- ("insert into " <> fromQi t <> " default values returning *") empty True +-- insertSelect t cols vals = B.Stmt +-- ("insert into " <> fromQi t <> " (" +-- <> T.intercalate ", " (map pgFmtIdent cols) +-- <> ") select " +-- <> T.intercalate ", " (map insertableValue vals)) +-- empty True +-- +-- update :: QualifiedIdentifier -> [T.Text] -> [JSON.Value] -> PStmt +-- update t cols vals = B.Stmt +-- ("update " <> fromQi t <> " set (" +-- <> T.intercalate ", " (map pgFmtIdent cols) +-- <> ") = (" +-- <> T.intercalate ", " (map insertableValue vals) +-- <> ")") +-- empty True callProc :: QualifiedIdentifier -> JSON.Object -> PStmt callProc qi params = do @@ -191,39 +191,39 @@ callProc qi params = do where assignment (n,v) = pgFmtIdent n <> ":=" <> insertableValue v -wherePred :: QualifiedIdentifier -> Net.QueryItem -> PStmt -wherePred table (col, predicate) = - B.Stmt (notOp <> " " <> pgFmtJsonbPath table (cs col) <> " " <> op <> " " <> - if opCode `elem` ["is","isnot"] then whiteList val - else cs sqlValue) - empty True - - where - headPredicate:rest = T.split (=='.') $ cs $ fromMaybe "." predicate - hasNot caseTrue caseFalse = if headPredicate == "not" then caseTrue else caseFalse - opCode = hasNot (head rest) headPredicate - notOp = hasNot headPredicate "" - val = hasNot (T.intercalate "." $ tail rest) (T.intercalate "." rest) - sqlValue = pgFmtValue opCode val - op = pgFmtOperator opCode +-- wherePred :: QualifiedIdentifier -> Net.QueryItem -> PStmt +-- wherePred table (col, predicate) = +-- B.Stmt (notOp <> " " <> pgFmtJsonbPath table (cs col) <> " " <> op <> " " <> +-- if opCode `elem` ["is","isnot"] then whiteList val +-- else cs sqlValue) +-- empty True +-- +-- where +-- headPredicate:rest = T.split (=='.') $ cs $ fromMaybe "." predicate +-- hasNot caseTrue caseFalse = if headPredicate == "not" then caseTrue else caseFalse +-- opCode = hasNot (head rest) headPredicate +-- notOp = hasNot headPredicate "" +-- val = hasNot (T.intercalate "." $ tail rest) (T.intercalate "." rest) +-- sqlValue = pgFmtValue opCode val +-- op = pgFmtOperator opCode whiteList :: T.Text -> T.Text whiteList val = fromMaybe (cs (pgFmtLit val) <> "::unknown ") (L.find ((==) . T.toLower $ val) ["null","true","false"]) -andq :: PStmt -andq = B.Stmt " and " empty True +-- andq :: PStmt +-- andq = B.Stmt " and " empty True -parseJsonbPath :: T.Text -> Maybe JsonbPath -parseJsonbPath p = - case T.splitOn "->>" p of - [a,b] -> - let i:is = T.splitOn "->" a in - Just $ DoubleArrow - (foldl SingleArrow (ColIdentifier i) (map KeyIdentifier is)) - (KeyIdentifier b) - _ -> Nothing +-- parseJsonbPath :: T.Text -> Maybe JsonbPath +-- parseJsonbPath p = +-- case T.splitOn "->>" p of +-- [a,b] -> +-- let i:is = T.splitOn "->" a in +-- Just $ DoubleArrow +-- (foldl SingleArrow (ColIdentifier i) (map KeyIdentifier is)) +-- (KeyIdentifier b) +-- _ -> Nothing trimNullChars :: T.Text -> T.Text trimNullChars = T.takeWhile (/= '\x0') @@ -352,16 +352,16 @@ pgFmtValue opCode val = pgFmtOperator :: T.Text -> T.Text pgFmtOperator opCode = fromMaybe "=" $ M.lookup opCode operators -pgFmtJsonbPath :: QualifiedIdentifier -> T.Text -> T.Text -pgFmtJsonbPath table p = - pgFmtJsonbPath' $ fromMaybe (ColIdentifier p) (parseJsonbPath p) - where - pgFmtJsonbPath' (ColIdentifier i) = fromQi table <> "." <> pgFmtIdent i - pgFmtJsonbPath' (KeyIdentifier i) = pgFmtLit i - pgFmtJsonbPath' (SingleArrow a b) = - pgFmtJsonbPath' a <> "->" <> pgFmtJsonbPath' b - pgFmtJsonbPath' (DoubleArrow a b) = - pgFmtJsonbPath' a <> "->>" <> pgFmtJsonbPath' b +-- pgFmtJsonbPath :: QualifiedIdentifier -> T.Text -> T.Text +-- pgFmtJsonbPath table p = +-- pgFmtJsonbPath' $ fromMaybe (ColIdentifier p) (parseJsonbPath p) +-- where +-- pgFmtJsonbPath' (ColIdentifier i) = fromQi table <> "." <> pgFmtIdent i +-- pgFmtJsonbPath' (KeyIdentifier i) = pgFmtLit i +-- pgFmtJsonbPath' (SingleArrow a b) = +-- pgFmtJsonbPath' a <> "->" <> pgFmtJsonbPath' b +-- pgFmtJsonbPath' (DoubleArrow a b) = +-- pgFmtJsonbPath' a <> "->>" <> pgFmtJsonbPath' b pgFmtIdent :: T.Text -> T.Text pgFmtIdent x = diff --git a/src/PostgREST/QueryBuilder.hs b/src/PostgREST/QueryBuilder.hs index 49019cb7d..cd04960fa 100644 --- a/src/PostgREST/QueryBuilder.hs +++ b/src/PostgREST/QueryBuilder.hs @@ -139,3 +139,12 @@ requestToQuery schema (Node (Update _ setWith conditions, (mainTbl, _)) _) = "RETURNING " <> fromQi qi <> ".*" ] formatSet ((c, jp), v) = pgFmtIdent c <> pgFmtJsonPath jp <> " = " <> insertableValue v +requestToQuery schema (Node (Delete _ conditions, (mainTbl, _)) _) = + query + where + qi = QualifiedIdentifier schema mainTbl + query = Data.Text.unwords [ + "DELETE FROM ", fromQi qi, + ("WHERE " <> intercalate " AND " ( map (pgFmtCondition qi ) conditions )) `emptyOnNull` conditions, + "RETURNING " <> fromQi qi <> ".*" + ] diff --git a/src/PostgREST/Types.hs b/src/PostgREST/Types.hs index 2dac663c1..8eeac7604 100644 --- a/src/PostgREST/Types.hs +++ b/src/PostgREST/Types.hs @@ -81,6 +81,7 @@ type SelectItem = (Field, Maybe Cast) type Path = [Text] data Query = Select { select::[SelectItem], from::[Text], where_::[Filter], order::Maybe [OrderTerm] } | Insert { into::Text, fields::[Field], values::[[Value]] } + | Delete { from::[Text], where_::[Filter] } | Update { into::Text, set::Map Field Value, where_::[Filter] } deriving (Show, Eq) data Filter = Filter {field::Field, operator::Operator, value::FValue} deriving (Show, Eq) type ApiNode = (Query, (NodeName, Maybe Relation)) diff --git a/test/Feature/InsertSpec.hs b/test/Feature/InsertSpec.hs index ae4bcc095..a7d4987ec 100644 --- a/test/Feature/InsertSpec.hs +++ b/test/Feature/InsertSpec.hs @@ -224,7 +224,8 @@ spec = afterAll_ resetDb $ around withApp $ do context "to a known uri" $ do context "without a fully-specified primary key" $ - it "is not an allowed operation" $ + it "is not an allowed operation" $ do + pendingWith "Decide on PUT usefullness" request methodPut "/compound_pk?k1=eq.12" [] [json| { "k1":12, "k2":42 } |] `shouldRespondWith` 405 @@ -232,13 +233,15 @@ spec = afterAll_ resetDb $ around withApp $ do context "with a fully-specified primary key" $ do context "not specifying every column in the table" $ - it "is rejected for lack of idempotence" $ + it "is rejected for lack of idempotence" $ do + pendingWith "Decide on PUT usefullness" request methodPut "/compound_pk?k1=eq.12&k2=eq.42" [] [json| { "k1":12, "k2":42 } |] `shouldRespondWith` 400 context "specifying every column in the table" . after_ (clearTable "compound_pk") $ do it "can create a new record" $ do + pendingWith "Decide on PUT usefullness" p <- request methodPut "/compound_pk?k1=eq.12&k2=eq.42" [] [json| { "k1":12, "k2":42, "extra":3 } |] liftIO $ do @@ -255,6 +258,7 @@ spec = afterAll_ resetDb $ around withApp $ do compoundExtra record `shouldBe` Just 3 it "can update an existing record" $ do + pendingWith "Decide on PUT usefullness" _ <- request methodPut "/compound_pk?k1=eq.12&k2=eq.42" [] [json| { "k1":12, "k2":42, "extra":4 } |] _ <- request methodPut "/compound_pk?k1=eq.12&k2=eq.42" [] @@ -269,7 +273,8 @@ spec = afterAll_ resetDb $ around withApp $ do context "with an auto-incrementing primary key" . after_ (clearTable "auto_incrementing_pk") $ - it "succeeds with 204" $ + it "succeeds with 204" $ do + pendingWith "Decide on PUT usefullness" request methodPut "/auto_incrementing_pk?id=eq.1" [] [json| { "id":1,