jimmy/postgrest
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

PUT path commented, DELETE rewritten, all statementT functions commented

Browse Source
This commit is contained in:
Ruslan Talpa
2015-10-30 12:08:25 +02:00
parent 738989c375
commit 6fd0d5648f
6 changed files with 332 additions and 179 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/PostgREST/App.hs
+65 -58
View File
@@ -20,7 +20,7 @@ import Data.List (find, sortBy, delete, transpose)
import Data.Maybe (fromMaybe, fromJust, isJust, isNothing, mapMaybe) import Data.Maybe (fromMaybe, fromJust, isJust, isNothing, mapMaybe)
import Data.Ord (comparing) import Data.Ord (comparing)
import Data.Ranged.Ranges (emptyRange) import Data.Ranged.Ranges (emptyRange)
import qualified Data.Set as S --import qualified Data.Set as S
import Data.String.Conversions (cs) import Data.String.Conversions (cs)
import Data.Text (Text, replace, strip) import Data.Text (Text, replace, strip)
import Data.Tree import Data.Tree
@@ -109,29 +109,29 @@ app dbstructure conf reqBody req =
request = parseRequest schema (fakeSourceRelations ++ allRels) table req reqBody request = parseRequest schema (fakeSourceRelations ++ allRels) table req reqBody
fakeSourceRelations = mapMaybe (toSourceRelation table) allRels fakeSourceRelations = mapMaybe (toSourceRelation table) allRels
([table], "PUT") -> -- ([table], "PUT") ->
handleJsonObj reqBody $ \obj -> do -- handleJsonObj reqBody $ \obj -> do
let qt = qualify table -- let qt = qualify table
pKeys = map pkName $ filter (filterPk schema table) allPrKeys -- pKeys = map pkName $ filter (filterPk schema table) allPrKeys
specifiedKeys = map (cs . fst) qq -- specifiedKeys = map (cs . fst) qq
if S.fromList pKeys /= S.fromList specifiedKeys -- if S.fromList pKeys /= S.fromList specifiedKeys
then return $ responseLBS status405 [] -- then return $ responseLBS status405 []
"You must speficy all and only primary keys as params" -- "You must speficy all and only primary keys as params"
else do -- else do
let tableCols = map (cs . colName) $ filter (filterCol schema table) allCols -- let tableCols = map (cs . colName) $ filter (filterCol schema table) allCols
cols = map cs $ HM.keys obj -- cols = map cs $ HM.keys obj
if S.fromList tableCols == S.fromList cols -- if S.fromList tableCols == S.fromList cols
then do -- then do
let vals = HM.elems obj -- let vals = HM.elems obj
H.unitEx $ iffNotT -- H.unitEx $ iffNotT
(whereT qt qq $ update qt cols vals) -- (whereT qt qq $ update qt cols vals)
(insertSelect qt cols vals) -- (insertSelect qt cols vals)
return $ responseLBS status204 [ jsonH ] "" -- return $ responseLBS status204 [ jsonH ] ""
--
else return $ if Prelude.null tableCols -- else return $ if Prelude.null tableCols
then responseLBS status404 [] "" -- then responseLBS status404 [] ""
else responseLBS status400 [] -- else responseLBS status400 []
"You must specify all columns in PUT request" -- "You must specify all columns in PUT request"
([table], "PATCH") -> do ([table], "PATCH") -> do
let echoRequested = hasPrefer "return=representation" let echoRequested = hasPrefer "return=representation"
@@ -153,16 +153,19 @@ app dbstructure conf reqBody req =
fakeSourceRelations = mapMaybe (toSourceRelation table) allRels fakeSourceRelations = mapMaybe (toSourceRelation table) allRels
([table], "DELETE") -> do ([table], "DELETE") -> do
let qt = qualify table case request of
del = countT Left e -> return $ responseLBS status400 [jsonH] $ cs e
. returningStarT Right (selectQuery, mutateQuery, _) -> do
. whereT qt qq let q = B.Stmt (createStatement selectQuery (Just (mutateQuery, False)) False Nothing [] True isCsv) V.empty True
$ deleteFrom qt row <- H.maybeEx q
row <- H.maybeEx del let (_, queryTotal, _, _) = extractQueryResult row
let (Identity deletedCount) = fromMaybe (Identity 0 :: Identity Int) row return $ if queryTotal == 0
return $ if deletedCount == 0 then responseLBS status404 [] ""
then responseLBS status404 [] "" else responseLBS status204 [("Content-Range", "*/"<> cs (show queryTotal))] ""
else responseLBS status204 [("Content-Range", "*/"<> cs (show deletedCount))] ""
where
request = parseRequest schema allRels table req reqBody
(["rpc", proc], "POST") -> do (["rpc", proc], "POST") -> do
let qi = QualifiedIdentifier schema (cs proc) let qi = QualifiedIdentifier schema (cs proc)
@@ -211,8 +214,8 @@ app dbstructure conf reqBody req =
filterTableAcl r (Table{tableAcl=a}) = r `elem` a filterTableAcl r (Table{tableAcl=a}) = r `elem` a
path = pathInfo req path = pathInfo req
verb = requestMethod req verb = requestMethod req
qq = queryString req --qq = queryString req
qualify = QualifiedIdentifier schema --qualify = QualifiedIdentifier schema
hdrs = requestHeaders req hdrs = requestHeaders req
lookupHeader = flip lookup hdrs lookupHeader = flip lookup hdrs
hasPrefer val = any (\(h,v) -> h == "Prefer" && v == val) hdrs hasPrefer val = any (\(h,v) -> h == "Prefer" && v == val) hdrs
@@ -266,22 +269,22 @@ contentTypeForAccept accept
findInAccept = flip find $ parseHttpAccept acceptH findInAccept = flip find $ parseHttpAccept acceptH
has = isJust . findInAccept . BS.isPrefixOf has = isJust . findInAccept . BS.isPrefixOf
handleJsonObj :: BL.ByteString -> (Object -> H.Tx P.Postgres s Response) -- handleJsonObj :: BL.ByteString -> (Object -> H.Tx P.Postgres s Response)
-> H.Tx P.Postgres s Response -- -> H.Tx P.Postgres s Response
handleJsonObj reqBody handler = do -- handleJsonObj reqBody handler = do
let p = eitherDecode reqBody -- let p = eitherDecode reqBody
case p of -- case p of
Left err -> -- Left err ->
return $ responseLBS status400 [jsonH] jErr -- return $ responseLBS status400 [jsonH] jErr
where -- where
jErr = encode . object $ -- jErr = encode . object $
[("message", String $ "Failed to parse JSON payload. " <> cs err)] -- [("message", String $ "Failed to parse JSON payload. " <> cs err)]
Right (Object o) -> handler o -- Right (Object o) -> handler o
Right _ -> -- Right _ ->
return $ responseLBS status400 [jsonH] jErr -- return $ responseLBS status400 [jsonH] jErr
where -- where
jErr = encode . object $ -- jErr = encode . object $
[("message", String "Expecting a JSON object")] -- [("message", String "Expecting a JSON object")]
parseCsvCell :: BL.ByteString -> Value parseCsvCell :: BL.ByteString -> Value
parseCsvCell s = if s == "NULL" then Null else String $ cs s 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)) then M.fromList <$> (zip <$> flds <*> (head <$> vals))
else Left "Expecting a sigle CSV line with header or a JSON object" else Left "Expecting a sigle CSV line with header or a JSON object"
allFilters = whereFilters qParams allFilters = whereFilters qParams
updateFilters = filter (not . ( '.' `elem` ) . fst) $ allFilters -- update filters can be only on the root table mutateFilters = filter (not . ( '.' `elem` ) . fst) $ allFilters -- update/delete filters can be only on the root table
cond = first formatParserError $ map snd <$> mapM pRequestFilter updateFilters cond = first formatParserError $ map snd <$> mapM pRequestFilter mutateFilters
selectApiRequest = augumentRequestWithJoin schema allRels selectApiRequest = augumentRequestWithJoin schema allRels
=<< buildSelectApiRequest rootName (selectStr qParams) filters (orderStr qParams) =<< buildSelectApiRequest rootName sel filters (orderStr qParams)
where 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" rootName = if method == "GET"
then rootTableName then rootTableName
else sourceSubqueryName 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 else filter (( '.' `elem` ) . fst) allFilters -- there can be no filters on the root table whre we are doing insert/update
selectQuery = requestToQuery schema <$> selectApiRequest selectQuery = requestToQuery schema <$> selectApiRequest
mutateQuery = requestToQuery schema <$> case method of mutateQuery = requestToQuery schema <$> case method of
"POST" -> (Node <$> ((,) <$> (Insert rootTableName <$> flds <*> vals) <*> pure (rootTableName, Nothing)) <*> pure []) "POST" -> (Node <$> ((,) <$> (Insert rootTableName <$> flds <*> vals) <*> pure (rootTableName, Nothing)) <*> pure [])
"PATCH" -> (Node <$> ((,) <$> (Update rootTableName <$> setWith <*> cond) <*> pure (rootTableName, Nothing)) <*> pure []) "PATCH" -> (Node <$> ((,) <$> (Update rootTableName <$> setWith <*> cond) <*> pure (rootTableName, Nothing)) <*> pure [])
_ -> undefined "DELETE" -> (Node <$> ((,) <$> (Delete [rootTableName] <$> cond) <*> pure (rootTableName, Nothing)) <*> pure [])
_ -> undefined
createStatement :: Text -> Maybe (Text, Bool) -> Bool -> Maybe NonnegRange -> [Text] -> Bool -> Bool -> Text createStatement :: Text -> Maybe (Text, Bool) -> Bool -> Maybe NonnegRange -> [Text] -> Bool -> Bool -> Text
createStatement selectQuery Nothing _ range _ countTable asCsv = createStatement selectQuery Nothing _ range _ countTable asCsv =
src/PostgREST/MainTest.hs
+131
View File
@@ -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
src/PostgREST/PgQuery.hs
+118 -118
View File
@@ -9,12 +9,12 @@ module PostgREST.PgQuery (
, wrapQuery , wrapQuery
, asJson , asJson
, callProc , callProc
, iffNotT -- , iffNotT
, update -- , update
, insertSelect -- , insertSelect
, deleteFrom -- , deleteFrom
, asCsvWithCount -- , asCsvWithCount
, asJsonWithCount -- , asJsonWithCount
, unquoted , unquoted
-- format functions -- format functions
@@ -30,10 +30,10 @@ module PostgREST.PgQuery (
, pgFmtAsJsonPath , pgFmtAsJsonPath
-- query transformers (to be removed) -- query transformers (to be removed)
, withT -- , withT
, countT -- , countT
, returningStarT -- , returningStarT
, whereT -- , whereT
-- query fragments -- query fragments
, sourceSubqueryName , sourceSubqueryName
@@ -70,7 +70,7 @@ import Data.Scientific (FPFormat (..), formatScientific,
import Data.String.Conversions (cs) import Data.String.Conversions (cs)
import qualified Data.Text as T import qualified Data.Text as T
import Data.Vector (empty) 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 Text.Regex.TDFA ((=~))
import Prelude import Prelude
@@ -107,82 +107,82 @@ operators = M.fromList [
] ]
whereT :: QualifiedIdentifier -> Net.Query -> StatementT -- whereT :: QualifiedIdentifier -> Net.Query -> StatementT
whereT table params q = -- whereT table params q =
if L.null cols -- if L.null cols
then q -- then q
else q <> B.Stmt " where " empty True <> conjunction -- else q <> B.Stmt " where " empty True <> conjunction
where -- where
cols = [ col | col <- params, fst col `notElem` ["order","select"] ] -- cols = [ col | col <- params, fst col `notElem` ["order","select"] ]
wherePredTable = wherePred table -- wherePredTable = wherePred table
conjunction = mconcat $ L.intersperse andq (map wherePredTable cols) -- conjunction = mconcat $ L.intersperse andq (map wherePredTable cols)
--
withT :: PStmt -> T.Text -> StatementT -- withT :: PStmt -> T.Text -> StatementT
withT (B.Stmt eq ep epre) v (B.Stmt wq wp wpre) = -- withT (B.Stmt eq ep epre) v (B.Stmt wq wp wpre) =
B.Stmt ("WITH " <> v <> " AS (" <> eq <> ") " <> wq <> " from " <> v) -- B.Stmt ("WITH " <> v <> " AS (" <> eq <> ") " <> wq <> " from " <> v)
(ep <> wp) -- (ep <> wp)
(epre && wpre) -- (epre && wpre)
--
iffNotT :: PStmt -> StatementT -- iffNotT :: PStmt -> StatementT
iffNotT (B.Stmt aq ap apre) (B.Stmt bq bp bpre) = -- iffNotT (B.Stmt aq ap apre) (B.Stmt bq bp bpre) =
B.Stmt -- B.Stmt
("WITH aaa AS (" <> aq <> " returning *) " <> -- ("WITH aaa AS (" <> aq <> " returning *) " <>
bq <> " WHERE NOT EXISTS (SELECT * FROM aaa)") -- bq <> " WHERE NOT EXISTS (SELECT * FROM aaa)")
(ap <> bp) -- (ap <> bp)
(apre && bpre) -- (apre && bpre)
--
countT :: StatementT -- countT :: StatementT
countT s = -- countT s =
s { B.stmtTemplate = "WITH qqq AS (" <> B.stmtTemplate s <> ") SELECT pg_catalog.count(1) FROM qqq" } -- s { B.stmtTemplate = "WITH qqq AS (" <> B.stmtTemplate s <> ") SELECT pg_catalog.count(1) FROM qqq" }
--
asCsvWithCount :: QualifiedIdentifier -> StatementT -- asCsvWithCount :: QualifiedIdentifier -> StatementT
asCsvWithCount table = withCount . asCsv table -- asCsvWithCount table = withCount . asCsv table
--
asCsv :: QualifiedIdentifier -> StatementT -- asCsv :: QualifiedIdentifier -> StatementT
asCsv table s = s { -- asCsv table s = s {
B.stmtTemplate = -- B.stmtTemplate =
"(select string_agg(quote_ident(column_name::text), ',') from " -- "(select string_agg(quote_ident(column_name::text), ',') from "
<> "(select column_name from information_schema.columns where quote_ident(table_schema) || '.' || table_name = '" -- <> "(select column_name from information_schema.columns where quote_ident(table_schema) || '.' || table_name = '"
<> fromQi table <> "' order by ordinal_position) h) || '\r' || " -- <> fromQi table <> "' order by ordinal_position) h) || '\r' || "
<> "coalesce(string_agg(substring(t::text, 2, length(t::text) - 2), '\r'), '') from (" -- <> "coalesce(string_agg(substring(t::text, 2, length(t::text) - 2), '\r'), '') from ("
<> B.stmtTemplate s <> ") t" } -- <> B.stmtTemplate s <> ") t" }
--
asJsonWithCount :: StatementT -- asJsonWithCount :: StatementT
asJsonWithCount = withCount . asJson -- asJsonWithCount = withCount . asJson
--
asJson :: StatementT asJson :: StatementT
asJson s = s { asJson s = s {
B.stmtTemplate = B.stmtTemplate =
"array_to_json(array_agg(row_to_json(t)))::character varying from (" "array_to_json(array_agg(row_to_json(t)))::character varying from ("
<> B.stmtTemplate s <> ") t" } <> B.stmtTemplate s <> ") t" }
--
withCount :: StatementT -- withCount :: StatementT
withCount s = s { B.stmtTemplate = "pg_catalog.count(t), " <> B.stmtTemplate s } -- withCount s = s { B.stmtTemplate = "pg_catalog.count(t), " <> B.stmtTemplate s }
--
returningStarT :: StatementT -- returningStarT :: StatementT
returningStarT s = s { B.stmtTemplate = B.stmtTemplate s <> " RETURNING *" } -- returningStarT s = s { B.stmtTemplate = B.stmtTemplate s <> " RETURNING *" }
--
deleteFrom :: QualifiedIdentifier -> PStmt -- deleteFrom :: QualifiedIdentifier -> PStmt
deleteFrom t = B.Stmt ("delete from " <> fromQi t) empty True -- deleteFrom t = B.Stmt ("delete from " <> fromQi t) empty True
--
insertSelect :: QualifiedIdentifier -> [T.Text] -> [JSON.Value] -> PStmt -- insertSelect :: QualifiedIdentifier -> [T.Text] -> [JSON.Value] -> PStmt
insertSelect t [] _ = B.Stmt -- insertSelect t [] _ = B.Stmt
("insert into " <> fromQi t <> " default values returning *") empty True -- ("insert into " <> fromQi t <> " default values returning *") empty True
insertSelect t cols vals = B.Stmt -- insertSelect t cols vals = B.Stmt
("insert into " <> fromQi t <> " (" -- ("insert into " <> fromQi t <> " ("
<> T.intercalate ", " (map pgFmtIdent cols) -- <> T.intercalate ", " (map pgFmtIdent cols)
<> ") select " -- <> ") select "
<> T.intercalate ", " (map insertableValue vals)) -- <> T.intercalate ", " (map insertableValue vals))
empty True -- empty True
--
update :: QualifiedIdentifier -> [T.Text] -> [JSON.Value] -> PStmt -- update :: QualifiedIdentifier -> [T.Text] -> [JSON.Value] -> PStmt
update t cols vals = B.Stmt -- update t cols vals = B.Stmt
("update " <> fromQi t <> " set (" -- ("update " <> fromQi t <> " set ("
<> T.intercalate ", " (map pgFmtIdent cols) -- <> T.intercalate ", " (map pgFmtIdent cols)
<> ") = (" -- <> ") = ("
<> T.intercalate ", " (map insertableValue vals) -- <> T.intercalate ", " (map insertableValue vals)
<> ")") -- <> ")")
empty True -- empty True
callProc :: QualifiedIdentifier -> JSON.Object -> PStmt callProc :: QualifiedIdentifier -> JSON.Object -> PStmt
callProc qi params = do callProc qi params = do
@@ -191,39 +191,39 @@ callProc qi params = do
where where
assignment (n,v) = pgFmtIdent n <> ":=" <> insertableValue v assignment (n,v) = pgFmtIdent n <> ":=" <> insertableValue v
wherePred :: QualifiedIdentifier -> Net.QueryItem -> PStmt -- wherePred :: QualifiedIdentifier -> Net.QueryItem -> PStmt
wherePred table (col, predicate) = -- wherePred table (col, predicate) =
B.Stmt (notOp <> " " <> pgFmtJsonbPath table (cs col) <> " " <> op <> " " <> -- B.Stmt (notOp <> " " <> pgFmtJsonbPath table (cs col) <> " " <> op <> " " <>
if opCode `elem` ["is","isnot"] then whiteList val -- if opCode `elem` ["is","isnot"] then whiteList val
else cs sqlValue) -- else cs sqlValue)
empty True -- empty True
--
where -- where
headPredicate:rest = T.split (=='.') $ cs $ fromMaybe "." predicate -- headPredicate:rest = T.split (=='.') $ cs $ fromMaybe "." predicate
hasNot caseTrue caseFalse = if headPredicate == "not" then caseTrue else caseFalse -- hasNot caseTrue caseFalse = if headPredicate == "not" then caseTrue else caseFalse
opCode = hasNot (head rest) headPredicate -- opCode = hasNot (head rest) headPredicate
notOp = hasNot headPredicate "" -- notOp = hasNot headPredicate ""
val = hasNot (T.intercalate "." $ tail rest) (T.intercalate "." rest) -- val = hasNot (T.intercalate "." $ tail rest) (T.intercalate "." rest)
sqlValue = pgFmtValue opCode val -- sqlValue = pgFmtValue opCode val
op = pgFmtOperator opCode -- op = pgFmtOperator opCode
whiteList :: T.Text -> T.Text whiteList :: T.Text -> T.Text
whiteList val = fromMaybe whiteList val = fromMaybe
(cs (pgFmtLit val) <> "::unknown ") (cs (pgFmtLit val) <> "::unknown ")
(L.find ((==) . T.toLower $ val) ["null","true","false"]) (L.find ((==) . T.toLower $ val) ["null","true","false"])
andq :: PStmt -- andq :: PStmt
andq = B.Stmt " and " empty True -- andq = B.Stmt " and " empty True
parseJsonbPath :: T.Text -> Maybe JsonbPath -- parseJsonbPath :: T.Text -> Maybe JsonbPath
parseJsonbPath p = -- parseJsonbPath p =
case T.splitOn "->>" p of -- case T.splitOn "->>" p of
[a,b] -> -- [a,b] ->
let i:is = T.splitOn "->" a in -- let i:is = T.splitOn "->" a in
Just $ DoubleArrow -- Just $ DoubleArrow
(foldl SingleArrow (ColIdentifier i) (map KeyIdentifier is)) -- (foldl SingleArrow (ColIdentifier i) (map KeyIdentifier is))
(KeyIdentifier b) -- (KeyIdentifier b)
_ -> Nothing -- _ -> Nothing
trimNullChars :: T.Text -> T.Text trimNullChars :: T.Text -> T.Text
trimNullChars = T.takeWhile (/= '\x0') trimNullChars = T.takeWhile (/= '\x0')
@@ -352,16 +352,16 @@ pgFmtValue opCode val =
pgFmtOperator :: T.Text -> T.Text pgFmtOperator :: T.Text -> T.Text
pgFmtOperator opCode = fromMaybe "=" $ M.lookup opCode operators pgFmtOperator opCode = fromMaybe "=" $ M.lookup opCode operators
pgFmtJsonbPath :: QualifiedIdentifier -> T.Text -> T.Text -- pgFmtJsonbPath :: QualifiedIdentifier -> T.Text -> T.Text
pgFmtJsonbPath table p = -- pgFmtJsonbPath table p =
pgFmtJsonbPath' $ fromMaybe (ColIdentifier p) (parseJsonbPath p) -- pgFmtJsonbPath' $ fromMaybe (ColIdentifier p) (parseJsonbPath p)
where -- where
pgFmtJsonbPath' (ColIdentifier i) = fromQi table <> "." <> pgFmtIdent i -- pgFmtJsonbPath' (ColIdentifier i) = fromQi table <> "." <> pgFmtIdent i
pgFmtJsonbPath' (KeyIdentifier i) = pgFmtLit i -- pgFmtJsonbPath' (KeyIdentifier i) = pgFmtLit i
pgFmtJsonbPath' (SingleArrow a b) = -- pgFmtJsonbPath' (SingleArrow a b) =
pgFmtJsonbPath' a <> "->" <> pgFmtJsonbPath' b -- pgFmtJsonbPath' a <> "->" <> pgFmtJsonbPath' b
pgFmtJsonbPath' (DoubleArrow a b) = -- pgFmtJsonbPath' (DoubleArrow a b) =
pgFmtJsonbPath' a <> "->>" <> pgFmtJsonbPath' b -- pgFmtJsonbPath' a <> "->>" <> pgFmtJsonbPath' b
pgFmtIdent :: T.Text -> T.Text pgFmtIdent :: T.Text -> T.Text
pgFmtIdent x = pgFmtIdent x =
src/PostgREST/QueryBuilder.hs
+9
View File
@@ -139,3 +139,12 @@ requestToQuery schema (Node (Update _ setWith conditions, (mainTbl, _)) _) =
"RETURNING " <> fromQi qi <> ".*" "RETURNING " <> fromQi qi <> ".*"
] ]
formatSet ((c, jp), v) = pgFmtIdent c <> pgFmtJsonPath jp <> " = " <> insertableValue v 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 <> ".*"
]
src/PostgREST/Types.hs
+1
View File
@@ -81,6 +81,7 @@ type SelectItem = (Field, Maybe Cast)
type Path = [Text] type Path = [Text]
data Query = Select { select::[SelectItem], from::[Text], where_::[Filter], order::Maybe [OrderTerm] } data Query = Select { select::[SelectItem], from::[Text], where_::[Filter], order::Maybe [OrderTerm] }
| Insert { into::Text, fields::[Field], values::[[Value]] } | Insert { into::Text, fields::[Field], values::[[Value]] }
| Delete { from::[Text], where_::[Filter] }
| Update { into::Text, set::Map Field Value, where_::[Filter] } deriving (Show, Eq) | Update { into::Text, set::Map Field Value, where_::[Filter] } deriving (Show, Eq)
data Filter = Filter {field::Field, operator::Operator, value::FValue} deriving (Show, Eq) data Filter = Filter {field::Field, operator::Operator, value::FValue} deriving (Show, Eq)
type ApiNode = (Query, (NodeName, Maybe Relation)) type ApiNode = (Query, (NodeName, Maybe Relation))
test/Feature/InsertSpec.hs
+8 -3
View File
@@ -224,7 +224,8 @@ spec = afterAll_ resetDb $ around withApp $ do
context "to a known uri" $ do context "to a known uri" $ do
context "without a fully-specified primary key" $ 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" [] request methodPut "/compound_pk?k1=eq.12" []
[json| { "k1":12, "k2":42 } |] [json| { "k1":12, "k2":42 } |]
`shouldRespondWith` 405 `shouldRespondWith` 405
@@ -232,13 +233,15 @@ spec = afterAll_ resetDb $ around withApp $ do
context "with a fully-specified primary key" $ do context "with a fully-specified primary key" $ do
context "not specifying every column in the table" $ 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" [] request methodPut "/compound_pk?k1=eq.12&k2=eq.42" []
[json| { "k1":12, "k2":42 } |] [json| { "k1":12, "k2":42 } |]
`shouldRespondWith` 400 `shouldRespondWith` 400
context "specifying every column in the table" . after_ (clearTable "compound_pk") $ do context "specifying every column in the table" . after_ (clearTable "compound_pk") $ do
it "can create a new record" $ do it "can create a new record" $ do
pendingWith "Decide on PUT usefullness"
p <- request methodPut "/compound_pk?k1=eq.12&k2=eq.42" [] p <- request methodPut "/compound_pk?k1=eq.12&k2=eq.42" []
[json| { "k1":12, "k2":42, "extra":3 } |] [json| { "k1":12, "k2":42, "extra":3 } |]
liftIO $ do liftIO $ do
@@ -255,6 +258,7 @@ spec = afterAll_ resetDb $ around withApp $ do
compoundExtra record `shouldBe` Just 3 compoundExtra record `shouldBe` Just 3
it "can update an existing record" $ do it "can update an existing record" $ do
pendingWith "Decide on PUT usefullness"
_ <- request methodPut "/compound_pk?k1=eq.12&k2=eq.42" [] _ <- request methodPut "/compound_pk?k1=eq.12&k2=eq.42" []
[json| { "k1":12, "k2":42, "extra":4 } |] [json| { "k1":12, "k2":42, "extra":4 } |]
_ <- request methodPut "/compound_pk?k1=eq.12&k2=eq.42" [] _ <- 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") $ 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" [] request methodPut "/auto_incrementing_pk?id=eq.1" []
[json| { [json| {
"id":1, "id":1,