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

Merge branch 'patch'

Browse Source
This commit is contained in:
Joe Nelson
2014-11-06 23:53:50 -08:00
parent ffa2870061 58adb5e828
commit 7bbeeb7c61
6 changed files with 122 additions and 26 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dbapi.hs
+10 -3
View File
@@ -146,14 +146,21 @@ app conn req respond =
cols <- columns ver (cs table) conn
let colNames = S.fromList $ map (cs . colName) cols
let specifiedCols = S.fromList $ map fst $ getRow row
return $ if colNames == specifiedCols then
responseLBS status200 [ jsonContentType ] ""
if colNames == specifiedCols then do
_ <- upsert ver table row qq conn
return $ responseLBS status204 [ jsonContentType ] ""
else if S.null colNames then responseLBS status404 [] ""
else return $ if S.null colNames then responseLBS status404 [] ""
else responseLBS status400 []
"You must specify all columns in PUT request"
)
([table], "PATCH") ->
jsonBodyAction req (\row -> do
_ <- update ver table row qq conn
return $ responseLBS status204 [ jsonContentType ] ""
)
(_, _) ->
return $ responseLBS status404 [] ""
src/PgQuery.hs
+17 -9
View File
@@ -2,6 +2,7 @@
module PgQuery (
getRows
, insert
, update
, upsert
, addUser
, signInRole
@@ -187,14 +188,21 @@ signInRole user pass conn = do
checkPass :: BS.ByteString -> BS.ByteString -> Bool
checkPass = validatePassword
upsert :: Schema -> Text -> SqlRow -> Net.Query -> Connection -> IO (M.Map String SqlValue)
upsert :: Schema -> Text -> SqlRow -> Net.Query -> Connection ->
IO (M.Map String SqlValue)
upsert schema table row qq conn = do
stmt <- prepare conn $ cs sql
stmt <- prepare conn $ cs $ upsertClause schema table row qq
_ <- execute stmt $ join $ replicate 2 $ sqlRowValues row
Just m <- fetchRowMap stmt
return m
m <- fetchRowMap stmt
return $ fromMaybe M.empty m
where sql = upsertClause schema table row qq
update :: Schema -> Text -> SqlRow -> Net.Query -> Connection ->
IO (M.Map String SqlValue)
update schema table row qq conn = do
stmt <- prepare conn $ cs $ updateClause schema table row qq
_ <- execute stmt $ sqlRowValues row
m <- fetchRowMap stmt
return $ fromMaybe M.empty m
placeholders :: Text -> SqlRow -> Text
placeholders symbol = intercalate ", " . map (const symbol) . getRow
@@ -213,16 +221,16 @@ insertClauseViaSelect schema table row =
intercalate ", " (map pgFmtIdent (sqlRowColumns row))
<> ") select " <> placeholders "?" row
updateClause :: Schema -> Text -> SqlRow -> Text
updateClause schema table row =
updateClause :: Schema -> Text -> SqlRow -> Net.Query -> Text
updateClause schema table row qq =
"update " <> pgFmtIdent schema <> "." <> pgFmtIdent table <> " set (" <>
intercalate ", " (map pgFmtIdent (sqlRowColumns row))
<> ") = (" <> placeholders "?" row <> ")"
<> whereClause qq
upsertClause :: Schema -> Text -> SqlRow -> Net.Query -> Text
upsertClause schema table row qq =
"with upsert as (" <> updateClause schema table row
<> whereClause qq
"with upsert as (" <> updateClause schema table row qq
<> " returning *) " <> insertClauseViaSelect schema table row
<> " where not exists (select * from upsert) returning *"
test/Feature/InsertSpec.hs
+67 -6
View File
@@ -13,8 +13,9 @@ import qualified Data.Aeson as JSON
import Data.Maybe (fromJust)
import Network.HTTP.Types.Header
import Network.HTTP.Types
import Control.Monad (replicateM_)
import TestTypes(IncPK, incStr, incNullableStr)
import TestTypes(IncPK(..), CompoundPK(..))
-- }}}
@@ -106,17 +107,39 @@ spec = around appWithFixture $ do
[json| { "k1":12, "k2":42 } |]
`shouldRespondWith` 400
context "specifying every column in the table" $
it "succeeds with 201 and link" $ do
context "specifying every column in the table" $ do
it "can create a new record" $ do
p <- request methodPut "/compound_pk?k1=eq.12&k2=eq.42" []
[json| { "k1":12, "k2":42, "extra":3 } |]
liftIO $ do
simpleBody p `shouldBe` ""
simpleStatus p `shouldBe` status200
simpleStatus p `shouldBe` status204
r <- get "/compound_pk?k1=eq.12&k2=eq.42"
let rows = fromJust (JSON.decode $ simpleBody r :: Maybe [CompoundPK])
liftIO $ do
length rows `shouldBe` 1
let record = head rows
compoundK1 record `shouldBe` 12
compoundK2 record `shouldBe` 42
compoundExtra record `shouldBe` Just 3
it "can update an existing record" $ do
_ <- 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" []
[json| { "k1":12, "k2":42, "extra":5 } |]
r <- get "/compound_pk?k1=eq.12&k2=eq.42"
let rows = fromJust (JSON.decode $ simpleBody r :: Maybe [CompoundPK])
liftIO $ do
length rows `shouldBe` 1
let record = head rows
compoundExtra record `shouldBe` Just 5
context "with an auto-incrementing primary key" $
it "succeeds with 201 and link" $
it "succeeds with 204" $
request methodPut "/auto_incrementing_pk?id=eq.1" []
[json| {
"id":1,
@@ -126,6 +149,44 @@ spec = around appWithFixture $ do
} |]
`shouldRespondWith` ResponseMatcher {
matchBody = Nothing,
matchStatus = 200,
matchStatus = 204,
matchHeaders = []
}
describe "Patching record" $ do
context "to unkonwn uri" $
it "gives a 404" $
request methodPatch "/fake" []
[json| { "real": false } |]
`shouldRespondWith` 404
context "on an empty table" $
it "succeeds with no effect" $
request methodPatch "/simple_pk" []
[json| { "extra":20 } |]
`shouldRespondWith` 204
context "in a nonempty table" $ do
it "can update a single item" $ do
g <- get "/items?id=eq.42"
liftIO $ simpleHeaders g
`shouldSatisfy` matchHeader "Content-Range" "\\*/0"
request methodPatch "/items?id=eq.1" []
[json| { "id":42 } |]
`shouldRespondWith` 204
g' <- get "/items?id=eq.42"
liftIO $ simpleHeaders g'
`shouldSatisfy` matchHeader "Content-Range" "0-0/1"
it "can update multiple items" $ do
replicateM_ 10 $ post "/auto_incrementing_pk"
[json| { non_nullable_string: "a" } |]
replicateM_ 10 $ post "/auto_incrementing_pk"
[json| { non_nullable_string: "b" } |]
_ <- request methodPatch
"/auto_incrementing_pk?non_nullable_string=eq.a" []
[json| { non_nullable_string: "c" } |]
g <- get "/auto_incrementing_pk?non_nullable_string=eq.c"
liftIO $ simpleHeaders g
`shouldSatisfy` matchHeader "Content-Range" "0-9/10"
test/TestTypes.hs
+25 -4
View File
@@ -1,6 +1,8 @@
module TestTypes (
IncPK(..),
fromList
IncPK(..)
, CompoundPK(..)
, incFromList
, compoundFromList
) where
import qualified Data.Aeson as JSON
@@ -26,9 +28,28 @@ instance JSON.FromJSON IncPK where
r .: "inserted_at"
parseJSON _ = mzero
fromList :: [(String, SqlValue)] -> IncPK
fromList row = IncPK
incFromList :: [(String, SqlValue)] -> IncPK
incFromList row = IncPK
(fromSql . fromJust $ lookup "id" row)
(fromSql . fromJust $ lookup "nullable_string" row)
(fromSql . fromJust $ lookup "non_nullable_string" row)
(fromSql . fromJust $ lookup "inserted_at" row)
data CompoundPK = CompoundPK {
compoundK1 :: Int
, compoundK2 :: Int
, compoundExtra :: Maybe Int
}
instance JSON.FromJSON CompoundPK where
parseJSON (JSON.Object r) = CompoundPK <$>
r .: "k1" <*>
r .: "k2" <*>
r .: "extra"
parseJSON _ = mzero
compoundFromList :: [(String, SqlValue)] -> CompoundPK
compoundFromList row = CompoundPK
(fromSql . fromJust $ lookup "k1" row)
(fromSql . fromJust $ lookup "k2" row)
(fromSql . fromJust $ lookup "extra" row)
test/Unit/ErrorsSpec.hs
-1
View File
@@ -15,7 +15,6 @@ import Network.HTTP.Types.Status (ok200)
spec :: Spec
spec = let
dbErrApp conn _ res = do
putStrLn "In fake app"
_ <- insert "1" "items" (SqlRow []) conn
runRaw conn "select 1/0"
_ <- insert "1" "items" (SqlRow []) conn
test/Unit/PgQuerySpec.hs
+3 -3
View File
@@ -10,7 +10,7 @@ import Database.HDBC (IConnection, SqlValue, toSql, prepare,
import PgQuery (LoginAttempt(..), insert, addUser, signInRole, checkPass
, pgFmtIdent, pgFmtLit)
import Types (SqlRow(SqlRow))
import TestTypes (fromList, incStr, incNullableStr, incInsert, incId)
import TestTypes (incFromList, incStr, incNullableStr, incInsert, incId)
import Data.Map (toList)
import Data.String.Conversions (cs)
import Data.Monoid ((<>))
@@ -34,13 +34,13 @@ spec = around dbWithSchema $ do
it "inserts and responds with a full object description" $ \conn -> do
r <- insert "1" "auto_incrementing_pk" (SqlRow [
("non_nullable_string", toSql ("a string"::String))]) conn
let returnRow = fromList . toList $ r
let returnRow = incFromList . toList $ r
incStr returnRow `shouldBe` "a string"
incNullableStr returnRow `shouldBe` Nothing
incInsert returnRow `shouldSatisfy` not . null
incId returnRow `shouldSatisfy` (>= 0)
tRows <- quickALQuery conn "select * from \"1\".auto_incrementing_pk" []
[returnRow] `shouldBe` map fromList tRows
[returnRow] `shouldBe` map incFromList tRows
it "throws an exception if the PK is not unique" $ \conn -> do
r <- insert "1" "auto_incrementing_pk" (SqlRow [