Use a mime type to request singular JSON responses (#763)

test/Feature/AuthSpec.hs

@@ -15,7 +15,7 @@ import Protolude hiding (get)
 
 spec :: SpecWith Application
 spec = describe "authorization" $ do
-  let single = ("Prefer","plurality=singular")
+  let single = ("Accept","application/vnd.pgrst.object+json")
 
   it "denies access to tables that anonymous does not own" $
     get "/authors_only" `shouldRespondWith` ResponseMatcher {
@@ -61,10 +61,7 @@ spec = describe "authorization" $ do
   it "sql functions can read custom and standard claims variables" $ do
     let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJzdWIiOiJmdW4iLCJqdGkiOiJmb28iLCJuYmYiOjEzMDA4MTkzODAsImV4cCI6OTk5OTk5OTk5OSwiaHR0cDovL3Bvc3RncmVzdC5jb20vZm9vIjp0cnVlLCJpc3MiOiJqb2UiLCJyb2xlIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIiwiaWF0IjoxMzAwODE5MzgwLCJhdWQiOiJldmVyeW9uZSJ9.AQmCA7CMScvfaDRMqRPeUY6eNf--69gpW-kxaWfq9X0"
     request methodPost "/rpc/reveal_big_jwt" [auth] "{}"
-      `shouldRespondWith` [json| [
-          {"sub":"fun", "jti":"foo", "nbf":1300819380, "exp":9999999999,
-          "http://postgrest.com/foo":true, "iss":"joe", "iat":1300819380,
-          "aud":"everyone"}] |]
+      `shouldRespondWith` [str|[{"iss":"joe","sub":"fun","aud":"everyone","exp":9999999999,"nbf":1300819380,"iat":1300819380,"jti":"foo","http://postgrest.com/foo":true}]|]
 
   it "allows users with permissions to see their tables" $ do
     let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJyb2xlIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIiwiaWQiOiJqZG9lIn0.y4vZuu1dDdwAl0-S00MCRWRYMlJ5YAMSir6Es6WtWx0"

test/Feature/DeleteSpec.hs

@@ -52,9 +52,15 @@ spec =
           , matchHeaders = ["Content-Range" <:> "0-0/*"]
           }
 
-    context "known route, unknown record" $
-      it "fails with 404" $
-        request methodDelete "/items?id=eq.101" [] "" `shouldRespondWith` 404
+    context "known route, no records matched" $
+      it "includes [] body if return=rep" $
+        request methodDelete "/items?id=eq.101"
+          [("Prefer", "return=representation")] ""
+          `shouldRespondWith` ResponseMatcher {
+            matchBody    = Just "[]"
+          , matchStatus  = 200
+          , matchHeaders = ["Content-Range" <:> "*/*"]
+          }
 
     context "totally unknown route" $
       it "fails with 404" $

test/Feature/InsertSpec.hs

@@ -39,12 +39,12 @@ spec = do
 
       it "filters columns in result using &select" $
         request methodPost "/menagerie?select=integer,varchar" [("Prefer", "return=representation")]
-          [json| {
+          [json| [{
             "integer": 14, "double": 3.14159, "varchar": "testing!"
           , "boolean": false, "date": "1900-01-01", "money": "$3.99"
           , "enum": "foo"
-          } |] `shouldRespondWith` ResponseMatcher {
-            matchBody    = Just [str|{"integer":14,"varchar":"testing!"}|]
+          }] |] `shouldRespondWith` ResponseMatcher {
+            matchBody    = Just [str|[{"integer":14,"varchar":"testing!"}]|]
           , matchStatus  = 201
           , matchHeaders = ["Content-Type" <:> "application/json; charset=utf-8"]
           }
@@ -53,7 +53,7 @@ spec = do
         request methodPost "/projects?select=id,name,clients{id,name}"
                 [("Prefer", "return=representation"), ("Prefer", "count=exact")]
           [str|{"id":6,"name":"New Project","client_id":2}|] `shouldRespondWith` ResponseMatcher {
-            matchBody    = Just [str|{"id":6,"name":"New Project","clients":{"id":2,"name":"Apple"}}|]
+            matchBody    = Just [str|[{"id":6,"name":"New Project","clients":{"id":2,"name":"Apple"}}]|]
           , matchStatus  = 201
           , matchHeaders = [ "Content-Type" <:> "application/json; charset=utf-8"
                            , "Location" <:> "/projects?id=eq.6"
@@ -86,9 +86,11 @@ spec = do
             incNullableStr record `shouldBe` Nothing
 
       context "into a table with simple pk" $
-        it "fails with 400 and error" $
-          post "/simple_pk" [json| { "extra":"foo"} |]
-            `shouldRespondWith` 400
+        it "fails with 400 and error" $ do
+          p <- post "/simple_pk" [json| { "extra":"foo"} |]
+          liftIO $ do
+            simpleStatus p `shouldBe` badRequest400
+            isErrorFormat (simpleBody p) `shouldBe` True
 
       context "into a table with no pk" $ do
         it "succeeds with 201 and a link including all fields" $ do
@@ -103,10 +105,18 @@ spec = do
                        [("Prefer", "return=representation")]
                        [json| { "a":"bar", "b":"baz" } |]
           liftIO $ do
-            simpleBody p `shouldBe` [json| { "a":"bar", "b":"baz" } |]
+            simpleBody p `shouldBe` [json| [{ "a":"bar", "b":"baz" }] |]
             simpleHeaders p `shouldSatisfy` matchHeader hLocation "/no_pk\\?a=eq.bar&b=eq.baz"
             simpleStatus p `shouldBe` created201
 
+        it "returns empty array when no items inserted, and return=rep" $ do
+          p <- request methodPost "/no_pk"
+                       [("Prefer", "return=representation")]
+                       [json| [] |]
+          liftIO $ do
+            simpleBody p `shouldBe` [json| [] |]
+            simpleStatus p `shouldBe` created201
+
         it "can insert in tables with no select privileges" $ do
           p <- request methodPost "/insertonly"
                        [("Prefer", "return=minimal")]
@@ -121,7 +131,7 @@ spec = do
                        [("Prefer", "return=representation")]
                        [json| { "a":null, "b":"foo" } |]
           liftIO $ do
-            simpleBody p `shouldBe` [json| { "a":null, "b":"foo" } |]
+            simpleBody p `shouldBe` [json| [{ "a":null, "b":"foo" }] |]
             simpleHeaders p `shouldSatisfy` matchHeader hLocation "/no_pk\\?a=is.null&b=eq.foo"
             simpleStatus p `shouldBe` created201
 
@@ -134,7 +144,7 @@ spec = do
                      [("Prefer", "return=representation")]
                      inserted
         liftIO $ do
-          JSON.decode (simpleBody p) `shouldBe` Just expectedObj
+          JSON.decode (simpleBody p) `shouldBe` Just [expectedObj]
           simpleStatus p `shouldBe` created201
           lookup hLocation (simpleHeaders p) `shouldBe` Just expectedLoc
 
@@ -154,8 +164,11 @@ spec = do
           lookup hLocation (simpleHeaders p) `shouldBe` Nothing
 
     context "with invalid json payload" $
-      it "fails with 400 and error" $
-        post "/simple_pk" "}{ x = 2" `shouldRespondWith` 400
+      it "fails with 400 and error" $ do
+        p <- post "/simple_pk" "}{ x = 2"
+        liftIO $ do
+          simpleStatus p `shouldBe` badRequest400
+          isErrorFormat (simpleBody p) `shouldBe` True
 
     context "with valid json payload" $
       it "succeeds and returns 201 created" $
@@ -177,7 +190,7 @@ spec = do
                      [("Prefer", "return=representation")]
                      inserted
           `shouldRespondWith` ResponseMatcher {
-            matchBody    = Just inserted
+            matchBody    = Just [str|[{"data":{"foo":"bar"}}]|]
           , matchStatus  = 201
           , matchHeaders = ["Location" <:> location]
           }
@@ -189,7 +202,7 @@ spec = do
                      [("Prefer", "return=representation")]
                      inserted
           `shouldRespondWith` ResponseMatcher {
-            matchBody    = Just inserted
+            matchBody    = Just [str|[{"data":[1,2,3]}]|]
           , matchStatus  = 201
           , matchHeaders = ["Location" <:> location]
           }
@@ -205,7 +218,7 @@ spec = do
       it "succeeds if correct select is applied" $
         request methodPost "/limited_article_stars?select=article_id,user_id" [("Prefer", "return=representation")]
           [json| {"article_id": 2, "user_id": 1} |] `shouldRespondWith` ResponseMatcher {
-            matchBody    = Just [str|{"article_id":2,"user_id":1}|]
+            matchBody    = Just [str|[{"article_id":2,"user_id":1}]|]
           , matchStatus  = 201
           , matchHeaders = []
           }
@@ -264,11 +277,12 @@ spec = do
                             "Location" <:> "/no_pk?a=is.null&b=eq.foo"]
           }
 
-
     context "with wrong number of columns" $
       it "fails for too few" $ do
         p <- request methodPost "/no_pk" [("Content-Type", "text/csv")] "a,b\nfoo,bar\nbaz"
-        liftIO $ simpleStatus p `shouldBe` badRequest400
+        liftIO $ do
+          simpleStatus p `shouldBe` badRequest400
+          isErrorFormat (simpleBody p) `shouldBe` True
 
     context "with unicode values" $
       it "succeeds and returns usable location header" $ do
@@ -277,7 +291,7 @@ spec = do
                      [("Prefer", "return=representation")]
                      payload
         liftIO $ do
-          simpleBody p `shouldBe` payload
+          simpleBody p `shouldBe` "["<>payload<>"]"
           simpleStatus p `shouldBe` created201
 
         let Just location = lookup hLocation $ simpleHeaders p
@@ -297,7 +311,11 @@ spec = do
       it "indicates no records found to update" $
         request methodPatch "/empty_table" []
           [json| { "extra":20 } |]
-            `shouldRespondWith` 404
+          `shouldRespondWith` ResponseMatcher {
+            matchBody    = Just "",
+            matchStatus  = 204,
+            matchHeaders = ["Content-Range" <:> "*/*"]
+          }
 
     context "in a nonempty table" $ do
       it "can update a single item" $ do
@@ -310,12 +328,32 @@ spec = do
             matchStatus  = 204,
             matchHeaders = ["Content-Range" <:> "0-0/*"]
           }
-        liftIO $
-          lookup hContentType (simpleHeaders p) `shouldBe` Nothing
+        liftIO $ lookup hContentType (simpleHeaders p) `shouldBe` Nothing
 
+        -- check it really got updated
         g' <- get "/items?id=eq.42"
         liftIO $ simpleHeaders g'
           `shouldSatisfy` matchHeader "Content-Range" "0-0/\\*"
+        -- put value back for other tests
+        void $ request methodPatch "/items?id=eq.42" [] [json| { "id":2 } |]
+
+      it "returns empty array when no rows updated and return=rep" $
+        request methodPatch "/items?id=eq.999999"
+          [("Prefer", "return=representation")] [json| { "id":999999 } |]
+          `shouldRespondWith` ResponseMatcher {
+            matchBody    = Just "[]",
+            matchStatus  = 200,
+            matchHeaders = ["Content-Range" <:> "*/*"]
+          }
+
+      it "returns updated object as array when return=rep" $
+        request methodPatch "/items?id=eq.2"
+          [("Prefer", "return=representation")] [json| { "id":2 } |]
+          `shouldRespondWith` ResponseMatcher {
+            matchBody    = Just [str|[{"id":2}]|],
+            matchStatus  = 200,
+            matchHeaders = ["Content-Range" <:> "0-0/*"]
+          }
 
       it "can update multiple items" $ do
         replicateM_ 10 $ post "/auto_incrementing_pk"
@@ -335,50 +373,6 @@ spec = do
         get "/no_pk?a=eq.keepme" `shouldRespondWith`
           [json| [{ a: "keepme", b: null }] |]
 
-      it "can update based on a computed column" $
-        request methodPatch
-          "/items?always_true=eq.false"
-          [("Prefer", "return=representation")]
-          [json| { id: 100 } |]
-          `shouldRespondWith` 404
-      it "can provide a representation" $ do
-        _ <- post "/items"
-          [json| { id: 1 } |]
-        request methodPatch
-          "/items?id=eq.1"
-          [("Prefer", "return=representation")]
-          [json| { id: 99 } |]
-          `shouldRespondWith` [json| [{id:99}] |]
-
-    context "in a table" $ do
-      it "can provide a singular representation when updating one entity" $ do
-        _ <- post "/addresses" [json| { id: 97, address: "A Street" } |]
-        p <- request methodPatch
-          "/addresses?id=eq.97"
-          [("Prefer", "return=representation,plurality=singular")]
-          [json| { address: "B Street" } |]
-        liftIO $ simpleBody p `shouldBe` [str|{"id":97,"address":"B Street"}|]
-      it "raises an error when attempting to update multiple entities with plurality=singular" $ do
-        _ <- post "/addresses" [json| { id: 98, address: "xxx" } |]
-        _ <- post "/addresses" [json| { id: 99, address: "yyy" } |]
-        p <- request methodPatch
-          "/addresses?id=gt.0"
-          [("Prefer", "return=representation,plurality=singular")]
-          [json| { address: "zzz" } |]
-        liftIO $ simpleStatus p `shouldBe` status400
-      it "can provide a singular representation when creating one entity" $ do
-        p <- request methodPost
-          "/addresses"
-          [("Prefer", "return=representation,plurality=singular")]
-          [json| [ { id: 100, address: "xxx" } ] |]
-        liftIO $ simpleBody p `shouldBe` [str|{"id":100,"address":"xxx"}|]
-      it "raises an error when attempting to create multiple entities with plurality=singular" $ do
-        p <- request methodPost
-          "/addresses"
-          [("Prefer", "return=representation,plurality=singular")]
-          [json| [ { id: 100, address: "xxx" }, { id: 101, address: "xxx" } ] |]
-        liftIO $ simpleStatus p `shouldBe` status400
-
       it "can set a json column to escaped value" $ do
         _ <- post "/json" [json| { data: {"escaped":"bar"} } |]
         request methodPatch "/json?data->>escaped=eq.bar"
@@ -390,6 +384,26 @@ spec = do
           , matchHeaders = []
           }
 
+      it "can update based on a computed column" $
+        request methodPatch
+          "/items?always_true=eq.false"
+          [("Prefer", "return=representation")]
+          [json| { id: 100 } |]
+          `shouldRespondWith` ResponseMatcher {
+            matchBody    = Just "[]",
+            matchStatus  = 200,
+            matchHeaders = ["Content-Range" <:> "*/*"]
+          }
+
+      it "can provide a representation" $ do
+        _ <- post "/items"
+          [json| { id: 1 } |]
+        request methodPatch
+          "/items?id=eq.1"
+          [("Prefer", "return=representation")]
+          [json| { id: 99 } |]
+          `shouldRespondWith` [json| [{id:99}] |]
+
     context "with unicode values" $
       it "succeeds and returns values intact" $ do
         void $ request methodPost "/no_pk" []
@@ -411,13 +425,13 @@ spec = do
         [ auth, ("Prefer", "return=representation") ]
         [json| { "secret": "nyancat" } |]
       liftIO $ do
-          simpleBody p1 `shouldBe` [str|{"owner":"jdoe","secret":"nyancat"}|]
-          simpleStatus p1 `shouldBe` created201
+        simpleBody p1 `shouldBe` [str|[{"owner":"jdoe","secret":"nyancat"}]|]
+        simpleStatus p1 `shouldBe` created201
 
       p2 <- request methodPost "/authors_only"
         -- jwt token for jroe
         [ authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJyb2xlIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIiwiaWQiOiJqcm9lIn0.YuF_VfmyIxWyuceT7crnNKEprIYXsJAyXid3rjPjIow", ("Prefer", "return=representation") ]
         [json| { "secret": "lolcat", "owner": "hacker" } |]
       liftIO $ do
-          simpleBody p2 `shouldBe` [str|{"owner":"jroe","secret":"lolcat"}|]
-          simpleStatus p2 `shouldBe` created201
+        simpleBody p2 `shouldBe` [str|[{"owner":"jroe","secret":"lolcat"}]|]
+        simpleStatus p2 `shouldBe` created201

test/Feature/QuerySpec.hs

@@ -4,7 +4,7 @@ import Test.Hspec hiding (pendingWith)
 import Test.Hspec.Wai
 import Test.Hspec.Wai.JSON
 import Network.HTTP.Types
-import Network.Wai.Test (SResponse(simpleHeaders))
+import Network.Wai.Test (SResponse(simpleHeaders,simpleStatus,simpleBody))
 
 import SpecHelper
 import Text.Heredoc
@@ -302,44 +302,6 @@ spec = do
       get "/projects?id=in.1,3&select=id,name,client_id,client{id,name}" `shouldRespondWith`
         [str|[{"id":1,"name":"Windows 7","client_id":1,"client":{"id":1,"name":"Microsoft"}},{"id":3,"name":"IOS","client_id":2,"client":{"id":2,"name":"Apple"}}]|]
 
-
-  describe "Plurality singular" $ do
-    it "will select an existing object" $
-      request methodGet "/items?id=eq.5" [("Prefer","plurality=singular")] ""
-        `shouldRespondWith` ResponseMatcher {
-          matchBody    = Just [json| {"id":5} |]
-        , matchStatus  = 200
-        , matchHeaders = []
-        }
-
-    it "can combine multiple prefer values" $
-      request methodGet "/items?id=eq.5" [("Prefer","plurality=singular , future=new, count=none")] ""
-        `shouldRespondWith` ResponseMatcher {
-          matchBody    = Just [json| {"id":5} |]
-        , matchStatus  = 200
-        , matchHeaders = []
-        }
-
-    it "works in the presence of a range header" $
-      let headers = ("Prefer","plurality=singular") :
-            rangeHdrs (ByteRangeFromTo 0 9) in
-      request methodGet "/items" headers ""
-        `shouldRespondWith` ResponseMatcher {
-          matchBody    = Just [json| {"id":1} |]
-        , matchStatus  = 200
-        , matchHeaders = []
-        }
-
-    it "will respond with 404 when not found" $
-      request methodGet "/items?id=eq.9999" [("Prefer","plurality=singular")] ""
-        `shouldRespondWith` 404
-
-    it "can shape plurality singular object routes" $
-      request methodGet "/projects_view?id=eq.1&select=id,name,clients{*},tasks{id,name}" [("Prefer","plurality=singular")] ""
-        `shouldRespondWith`
-          [str|{"id":1,"name":"Windows 7","clients":{"id":1,"name":"Microsoft"},"tasks":[{"id":1,"name":"Design w7"},{"id":2,"name":"Code w7"}]}|]
-
-
   describe "ordering response" $ do
     it "by a column asc" $
       get "/items?id=lte.2&order=id.asc"
@@ -531,10 +493,14 @@ spec = do
         post "/rpc/getitemrange" [json| { "min": 2, "max": 4 } |] `shouldRespondWith`
           [json| [ {"id": 3}, {"id":4} ] |]
 
+    context "unknown function" $
+      it "returns 404" $
+        post "/rpc/fakefunc" [json| {} |] `shouldRespondWith` 404
+
     context "shaping the response returned by a proc" $ do
       it "returns a project" $
         post "/rpc/getproject" [json| { "id": 1} |] `shouldRespondWith`
-          [json|[{"id":1,"name":"Windows 7","client_id":1}]|]
+          [str|[{"id":1,"name":"Windows 7","client_id":1}]|]
 
       it "can filter proc results" $
         post "/rpc/getallprojects?id=gt.1&id=lt.5&select=id" [json| {} |] `shouldRespondWith`
@@ -548,20 +514,13 @@ spec = do
              , matchHeaders = ["Content-Range" <:> "1-2/*"]
              }
 
-
-
-      it "prefer singular" $
-        request methodPost "/rpc/getproject"
-          [("Prefer","plurality=singular")] [json| { "id": 1} |] `shouldRespondWith`
-          [json|{"id":1,"name":"Windows 7","client_id":1}|]
-
       it "select works on the first level" $
         post "/rpc/getproject?select=id,name" [json| { "id": 1} |] `shouldRespondWith`
-          [json|[{"id":1,"name":"Windows 7"}]|]
+          [str|[{"id":1,"name":"Windows 7"}]|]
 
       it "can embed foreign entities to the items returned by a proc" $
         post "/rpc/getproject?select=id,name,client{id},tasks{id}" [json| { "id": 1} |] `shouldRespondWith`
-          [json|[{"id":1,"name":"Windows 7","client":{"id":1},"tasks":[{"id":1},{"id":2}]}]|]
+          [str|[{"id":1,"name":"Windows 7","client":{"id":1},"tasks":[{"id":1},{"id":2}]}]|]
 
     context "a proc that returns an empty rowset" $
       it "returns empty json array" $
@@ -582,17 +541,17 @@ spec = do
         request methodPost "/rpc/sayhello"
           (acceptHdrs "audio/mpeg3") [json| { "name": "world" } |]
             `shouldRespondWith` 415
-      it "rejects malformed json payload" $
-        request methodPost "/rpc/sayhello"
+      it "rejects malformed json payload" $ do
+        p <- request methodPost "/rpc/sayhello"
           (acceptHdrs "application/json") "sdfsdf"
-            `shouldRespondWith` 400
-      -- it used to be 404 and it makes sense but in another part we decided that it's good to return
-      -- PostgreSQL errors (and have the proxy handle them) and this saves us an aditional query on each rpc request
-      it "responds with 400 on an unexisting proc" $
-        post "/rpc/fake" "{}" `shouldRespondWith` 400
-      it "treats simple plpgsql raise as invalid input" $
-        post "/rpc/problem" "{}" `shouldRespondWith` 400
-
+        liftIO $ do
+          simpleStatus p `shouldBe` badRequest400
+          isErrorFormat (simpleBody p) `shouldBe` True
+      it "treats simple plpgsql raise as invalid input" $ do
+        p <- post "/rpc/problem" "{}"
+        liftIO $ do
+          simpleStatus p `shouldBe` badRequest400
+          isErrorFormat (simpleBody p) `shouldBe` True
 
     context "unsupported verbs" $ do
       it "DELETE fails" $
@@ -623,7 +582,7 @@ spec = do
           [("Prefer","params=single-object")] [json| { "p1": 1, "p2": "text", "p3" : {"obj":"text"} } |] `shouldRespondWith`
           [json| { "p1": 1, "p2": "text", "p3" : {"obj":"text"} } |]
 
-      it "accepts parameters from an html form" $ 
+      it "accepts parameters from an html form" $
         request methodPost "/rpc/singlejsonparam"
           [("Prefer","params=single-object"),("Content-Type", "application/x-www-form-urlencoded")]
           ("integer=7&double=2.71828&varchar=forms+are+fun&" <>

test/Feature/SingularSpec.hs

@@ -0,0 +1,198 @@
+module Feature.SingularSpec where
+
+import Text.Heredoc
+import Test.Hspec
+import Test.Hspec.Wai
+import Test.Hspec.Wai.JSON
+import Network.HTTP.Types
+import Network.Wai.Test (SResponse(..))
+
+import Network.Wai (Application)
+
+import SpecHelper
+import Protolude hiding (get)
+
+
+spec :: SpecWith Application
+spec =
+  describe "Requesting singular json object" $ do
+    let pgrstObj = "application/vnd.pgrst.object+json"
+        singular = ("Accept", pgrstObj)
+
+    context "with GET request" $ do
+      it "fails for zero rows" $
+        request methodGet  "/items?id=gt.0&id=lt.0" [singular] ""
+          `shouldRespondWith` 406
+
+      it "will select an existing object" $ do
+        request methodGet "/items?id=eq.5" [singular] ""
+          `shouldRespondWith` [str|{"id":5}|]
+        -- also test without the +json suffix
+        request methodGet "/items?id=eq.5"
+          [("Accept", "application/vnd.pgrst.object")] ""
+          `shouldRespondWith` [str|{"id":5}|]
+
+      it "can combine multiple prefer values" $
+        request methodGet "/items?id=eq.5" [singular, ("Prefer","count=none")] ""
+          `shouldRespondWith` [str|{"id":5}|]
+
+      it "can shape plurality singular object routes" $
+        request methodGet "/projects_view?id=eq.1&select=id,name,clients{*},tasks{id,name}" [singular] ""
+          `shouldRespondWith`
+            [str|{"id":1,"name":"Windows 7","clients":{"id":1,"name":"Microsoft"},"tasks":[{"id":1,"name":"Design w7"},{"id":2,"name":"Code w7"}]}|]
+
+    context "when updating rows" $ do
+
+      it "works for one row" $ do
+        _ <- post "/addresses" [json| { id: 97, address: "A Street" } |]
+        request methodPatch
+          "/addresses?id=eq.97"
+          [("Prefer", "return=representation"), singular]
+          [json| { address: "B Street" } |]
+          `shouldRespondWith`
+            [str|{"id":97,"address":"B Street"}|]
+
+      it "raises an error for multiple rows" $ do
+        _ <- post "/addresses" [json| { id: 98, address: "xxx" } |]
+        _ <- post "/addresses" [json| { id: 99, address: "yyy" } |]
+        p <- request methodPatch
+          "/addresses?id=gt.0"
+          [("Prefer", "return=representation"), singular]
+          [json| { address: "zzz" } |]
+        liftIO $ do
+          simpleStatus p `shouldBe` notAcceptable406
+          isErrorFormat (simpleBody p) `shouldBe` True
+
+        -- the rows should not be updated, either
+        get "/addresses?id=eq.98" `shouldRespondWith` [str|[{"id":98,"address":"xxx"}]|]
+
+      it "raises an error for zero rows" $ do
+        p <- request methodPatch  "/items?id=gt.0&id=lt.0"
+          [("Prefer", "return=representation"), singular] [json|{"id":1}|]
+        liftIO $ do
+          simpleStatus p `shouldBe` notAcceptable406
+          isErrorFormat (simpleBody p) `shouldBe` True
+
+    context "when creating rows" $ do
+
+      it "works for one row" $ do
+        p <- request methodPost
+          "/addresses"
+          [("Prefer", "return=representation"), singular]
+          [json| [ { id: 100, address: "xxx" } ] |]
+        liftIO $ simpleBody p `shouldBe` [str|{"id":100,"address":"xxx"}|]
+
+      it "works for one row even with return=minimal" $ do
+        request methodPost "/addresses"
+          [("Prefer", "return=minimal"), singular]
+          [json| [ { id: 101, address: "xxx" } ] |]
+          `shouldRespondWith` ResponseMatcher {
+            matchBody    = Just ""
+          , matchStatus  = 201
+          , matchHeaders = ["Content-Range" <:> "*/*"]
+          }
+        -- and the element should exist
+        get "/addresses?id=eq.101"
+          `shouldRespondWith` ResponseMatcher {
+            matchBody    = Just [str|[{"id":101,"address":"xxx"}]|]
+          , matchStatus  = 200
+          , matchHeaders = []
+          }
+
+      it "raises an error when attempting to create multiple entities" $ do
+        p <- request methodPost
+          "/addresses"
+          [("Prefer", "return=representation"), singular]
+          [json| [ { id: 200, address: "xxx" }, { id: 201, address: "yyy" } ] |]
+        liftIO $ simpleStatus p `shouldBe` notAcceptable406
+
+        -- the rows should not exist, either
+        get "/addresses?id=eq.200" `shouldRespondWith` "[]"
+
+      it "return=minimal allows request to create multiple elements" $
+        request methodPost "/addresses"
+          [("Prefer", "return=minimal"), singular]
+          [json| [ { id: 200, address: "xxx" }, { id: 201, address: "yyy" } ] |]
+          `shouldRespondWith` ResponseMatcher {
+            matchBody    = Just ""
+          , matchStatus  = 201
+          , matchHeaders = ["Content-Range" <:> "*/*"]
+          }
+
+      it "raises an error when creating zero entities" $ do
+        p <- request methodPost
+          "/addresses"
+          [("Prefer", "return=representation"), singular]
+          [json| [ ] |]
+        liftIO $ do
+          simpleStatus p `shouldBe` notAcceptable406
+          isErrorFormat (simpleBody p) `shouldBe` True
+
+    context "when deleting rows" $ do
+
+      it "works for one row" $ do
+        p <- request methodDelete
+          "/items?id=eq.11"
+          [("Prefer", "return=representation"), singular] ""
+        liftIO $ simpleBody p `shouldBe` [str|{"id":11}|]
+
+      it "raises an error when attempting to delete multiple entities" $ do
+        let firstItems = "/items?id=gt.0&id=lt.11"
+        request methodDelete firstItems
+          [("Prefer", "return=representation"), singular] ""
+          `shouldRespondWith` 406
+
+        -- the rows should not exist, either
+        get firstItems
+          `shouldRespondWith` ResponseMatcher {
+            matchBody    = Nothing
+          , matchStatus  = 200
+          , matchHeaders = ["Content-Range" <:> "0-9/*"]
+          }
+
+      it "raises an error when deleting zero entities" $ do
+        p <- request methodDelete "/items?id=lt.0"
+          [("Prefer", "return=representation"), singular] ""
+        liftIO $ do
+          simpleStatus p `shouldBe` notAcceptable406
+          isErrorFormat (simpleBody p) `shouldBe` True
+
+    context "when calling a stored proc" $ do
+
+      it "fails for zero rows" $ do
+        p <- request methodPost "/rpc/getproject"
+          [singular] [json|{ "id": 9999999}|]
+        liftIO $ do
+          simpleStatus p `shouldBe` notAcceptable406
+          isErrorFormat (simpleBody p) `shouldBe` True
+
+      -- this one may be controversial, should vnd.pgrst.object include
+      -- the likes of 2 and "hello?"
+      it "succeeds for scalar result" $
+        request methodPost "/rpc/sayhello"
+          [singular] [json|{ "name": "world"}|]
+          `shouldRespondWith` 200
+
+      it "returns a single object for json proc" $
+        request methodPost "/rpc/getproject"
+          [singular] [json|{ "id": 1}|] `shouldRespondWith`
+          [str|{"id":1,"name":"Windows 7","client_id":1}|]
+
+      it "fails for multiple rows" $ do
+        p <- request methodPost "/rpc/getallprojects" [singular] "{}"
+        liftIO $ do
+          simpleStatus p `shouldBe` notAcceptable406
+          isErrorFormat (simpleBody p) `shouldBe` True
+
+      it "executes the proc exactly once per request" $ do
+        request methodPost "/rpc/getproject?select=id,name" [] [json| {"id": 1} |]
+          `shouldRespondWith` [str|[{"id":1,"name":"Windows 7"}]|]
+        p <- request methodPost "/rpc/setprojects" [singular]
+          [json| {"id_l": 1, "id_h": 2, "name": "changed"} |]
+        liftIO $ do
+          simpleStatus p `shouldBe` notAcceptable406
+          isErrorFormat (simpleBody p) `shouldBe` True
+
+        -- should not actually have executed the function
+        request methodPost "/rpc/getproject?select=id,name" [] [json| {"id": 1} |]
+          `shouldRespondWith` [str|[{"id":1,"name":"Windows 7"}]|]

test/Main.hs

@@ -23,6 +23,7 @@ import qualified Feature.QueryLimitedSpec
 import qualified Feature.QuerySpec
 import qualified Feature.RangeSpec
 import qualified Feature.StructureSpec
+import qualified Feature.SingularSpec
 import qualified Feature.UnicodeSpec
 import qualified Feature.ProxySpec
 
@@ -81,5 +82,6 @@ main = do
     , ("Feature.InsertSpec"       , Feature.InsertSpec.spec)
     , ("Feature.QuerySpec"        , Feature.QuerySpec.spec)
     , ("Feature.RangeSpec"        , Feature.RangeSpec.spec)
+    , ("Feature.SingularSpec"     , Feature.SingularSpec.spec)
     , ("Feature.StructureSpec"    , Feature.StructureSpec.spec)
     ]

test/SpecHelper.hs

@@ -7,9 +7,12 @@ import System.Environment (getEnv)
 
 import qualified Data.ByteString.Base64 as B64 (encode, decodeLenient)
 import Data.CaseInsensitive (CI(..))
+import qualified Data.Set as S
+import qualified Data.Map.Strict as M
 import Data.List (lookup)
 import Text.Regex.TDFA ((=~))
 import qualified Data.ByteString.Char8 as BS
+import qualified Data.ByteString.Lazy as BL
 import System.Process (readProcess)
 
 import PostgREST.Config (AppConfig(..))
@@ -21,7 +24,7 @@ import Network.HTTP.Types
 import Network.Wai.Test (SResponse(simpleStatus, simpleHeaders, simpleBody))
 
 import Data.Maybe (fromJust)
-import Data.Aeson (decode)
+import Data.Aeson (decode, Value(..))
 import qualified Data.JsonSchema.Draft4 as D4
 
 import Protolude
@@ -123,3 +126,15 @@ authHeaderBasic u p =
 authHeaderJWT :: BS.ByteString -> Header
 authHeaderJWT token =
   (hAuthorization, "Bearer " <> token)
+
+-- | Tests whether the text can be parsed as a json object comtaining
+-- the key "message", and optional keys "details", "hint", "code",
+-- and no extraneous keys
+isErrorFormat :: BL.ByteString -> Bool
+isErrorFormat s =
+  "message" `S.member` keys &&
+    S.null (S.difference keys validKeys)
+ where
+  obj = decode s :: Maybe (M.Map Text Value)
+  keys = fromMaybe S.empty (M.keysSet <$> obj)
+  validKeys = S.fromList ["message", "details", "hint", "code"]

test/fixtures/schema.sql

@@ -1091,6 +1091,12 @@ CREATE FUNCTION getallprojects() RETURNS SETOF projects
     SELECT * FROM test.projects;
 $_$;
 
+CREATE FUNCTION setprojects(id_l int, id_h int, name text) RETURNS SETOF projects
+    LANGUAGE sql
+    AS $_$
+    update test.projects set name = $3 WHERE id >= $1 AND id <= $2 returning *;
+$_$;
+
 --
 -- PostgreSQL database dump complete
 --