From 4d81959a2aa941f4b54afa4e3688bdbd027f79fc Mon Sep 17 00:00:00 2001
From: Joe Nelson <cred+github@begriffs.com>
Date: Sun, 7 Sep 2014 14:12:51 -0700
Subject: [PATCH] Fix Location link in post to db lacking a primary key

Fixes #29
---
 src/Dbapi.hs               | 4 +++-
 test/Feature/InsertSpec.hs | 8 ++++++++
 2 files changed, 11 insertions(+), 1 deletion(-)

diff --git a/src/Dbapi.hs b/src/Dbapi.hs
index 38c21e22c..59d818c10 100644
--- a/src/Dbapi.hs
+++ b/src/Dbapi.hs
@@ -75,7 +75,9 @@ app conn req respond = do
         jsonBodyAction req (\row -> do
           allvals <- insert ver table row conn
           keys <- primaryKeyColumns ver (unpack table) conn
-          let keyvals = allvals `intersection` fromList (zip keys $ repeat SqlNull)
+          let keyvals = if null keys
+                        then allvals
+                        else allvals `intersection` fromList (zip keys $ repeat SqlNull)
           let params = urlEncodeVars $ map (\t -> (fst t, "eq." <> convert (snd t) :: String)) $ toList keyvals
           return $ responseLBS status201
             [ jsonContentType
diff --git a/test/Feature/InsertSpec.hs b/test/Feature/InsertSpec.hs
index 52b07c93b..fd4835c8c 100644
--- a/test/Feature/InsertSpec.hs
+++ b/test/Feature/InsertSpec.hs
@@ -50,6 +50,14 @@ spec = around appWithFixture $
           post "/simple_pk" [json| { "extra":"foo"} |]
             `shouldRespondWith` 400
 
+      context "into a table with no pk" $
+        it "succeeds with 201 and a link including all fields" $ do
+          p <- post "/no_pk" [json| { "a":"foo", "b":"bar" } |]
+          liftIO $ do
+            simpleBody p `shouldBe` ""
+            simpleHeaders p `shouldSatisfy` matchHeader hLocation "/no_pk\\?a=eq.foo&b=eq.bar"
+            simpleStatus p `shouldBe` created201
+
     context "with compound pk supplied" $
       it "builds response location header appropriately" $
         post "/compound_pk" [json| { "k1":12, "k2":42 } |]