Derp, actually put the data on a put request

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"
       )

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
 

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

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)

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 [