From dd9d9cb28361ba9141ba6319ff41e5c2b92c6b92 Mon Sep 17 00:00:00 2001
From: Joe Nelson <cred+github@begriffs.com>
Date: Wed, 10 Sep 2014 20:44:17 -0700
Subject: [PATCH] Disallow non-idempotent PUTs

---
 src/Dbapi.hs | 22 +++++++++++-----------
 1 file changed, 11 insertions(+), 11 deletions(-)

diff --git a/src/Dbapi.hs b/src/Dbapi.hs
index 478cc08bd..ca30304a3 100644
--- a/src/Dbapi.hs
+++ b/src/Dbapi.hs
@@ -3,7 +3,7 @@
 -- {{{ Imports
 module Dbapi where
 
-import Types (SqlRow)
+import Types (SqlRow, getRow)
 
 import Control.Exception (try)
 import Control.Monad (join)
@@ -34,7 +34,8 @@ import qualified Data.ByteString.Char8 as BS
 import Database.HDBC.PostgreSQL (Connection)
 import Database.HDBC.Types (SqlError, seErrorMsg)
 import Database.HDBC.SqlValue (SqlValue(..))
-import PgStructure (printTables, printColumns, primaryKeyColumns)
+import PgStructure (printTables, printColumns, primaryKeyColumns,
+                    columns, Column(colName))
 
 import qualified Data.Aeson as JSON
 import Data.Text (pack, unpack)
@@ -111,16 +112,15 @@ app conn req respond = do
               then return $ responseLBS status405 []
                    "You must speficy all and only primary keys as params"
               else do
-                _ <- upsert ver table row qq conn
-                return $ responseLBS status201 [] ""
-          -- allvals <- insert ver table row conn
-          -- let keyvals = allvals `intersection` fromList (zip keys $ repeat SqlNull)
-          -- let params = urlEncodeVars $ map (\t -> (fst t, "eq." <> convert (snd t) :: String)) $ toList keyvals
-            -- [ jsonContentType
-            -- , (hLocation, "/" <> encodeUtf8 table <> "?" <> BS.pack params)
-            -- ] ""
+                cols <- columns ver (unpack table) conn
+                let colNames = S.fromList $ map (pack . colName) cols
+                let specifiedCols = S.fromList $ map fst $ getRow row
+                if colNames == specifiedCols then do
+                  _ <- upsert ver table row qq conn
+                  return $ responseLBS status201 [] ""
+                  else return $ responseLBS status400 []
+                    "Missing column(s) in PUT request"
         )
-
       (_, _) ->
         return $ responseLBS status404 [] ""