From 76ea92bfce891a1f8e1dc150733bca97368c04b5 Mon Sep 17 00:00:00 2001 From: Joe Nelson Date: Thu, 6 Nov 2014 18:31:13 -0800 Subject: [PATCH] Derp, actually put the data on a put request --- src/Dbapi.hs | 7 +++--- src/PgQuery.hs | 4 ++-- test/Feature/InsertSpec.hs | 45 +++++++++++++++++++++++++++++++++----- test/TestTypes.hs | 29 ++++++++++++++++++++---- test/Unit/PgQuerySpec.hs | 6 ++--- 5 files changed, 73 insertions(+), 18 deletions(-) diff --git a/src/Dbapi.hs b/src/Dbapi.hs index 0d09dbcab..d327d8767 100644 --- a/src/Dbapi.hs +++ b/src/Dbapi.hs @@ -146,10 +146,11 @@ 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" ) diff --git a/src/PgQuery.hs b/src/PgQuery.hs index 8fb7e3ed0..94fe888c9 100644 --- a/src/PgQuery.hs +++ b/src/PgQuery.hs @@ -191,8 +191,8 @@ upsert :: Schema -> Text -> SqlRow -> Net.Query -> Connection -> IO (M.Map Strin upsert schema table row qq conn = do stmt <- prepare conn $ cs sql _ <- 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 diff --git a/test/Feature/InsertSpec.hs b/test/Feature/InsertSpec.hs index 4fa68bbf8..2bf48b870 100644 --- a/test/Feature/InsertSpec.hs +++ b/test/Feature/InsertSpec.hs @@ -14,7 +14,7 @@ import Data.Maybe (fromJust) import Network.HTTP.Types.Header import Network.HTTP.Types -import TestTypes(IncPK, incStr, incNullableStr) +import TestTypes(IncPK(..), CompoundPK(..)) -- }}} @@ -106,17 +106,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 +148,17 @@ spec = around appWithFixture $ do } |] `shouldRespondWith` ResponseMatcher { matchBody = Nothing, - matchStatus = 200, + matchStatus = 204, matchHeaders = [] } + + describe "Patching record" $ + + context "to unkonwn uri" $ + it "gives a 404" $ + request methodPatch "/fake" [] + [json| { "real": false } |] + `shouldRespondWith` 404 + + -- context "on an empty table" $ + -- it "succeeds diff --git a/test/TestTypes.hs b/test/TestTypes.hs index 6e997ab5b..95998406d 100644 --- a/test/TestTypes.hs +++ b/test/TestTypes.hs @@ -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) diff --git a/test/Unit/PgQuerySpec.hs b/test/Unit/PgQuerySpec.hs index 948e8e17c..9e0f2c7c2 100644 --- a/test/Unit/PgQuerySpec.hs +++ b/test/Unit/PgQuerySpec.hs @@ -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 [