Merge pull request #595 from league/master

URL-encode Location header in 201 response (#588)

CHANGELOG.md

@@ -17,6 +17,7 @@ This project adheres to [Semantic Versioning](http://semver.org/).
 - Prevent role from being changed twice - @begriffs
 - Use read-only transaction for read requests - @ruslantalpa
 - Include entities from the same parent table using two different foreign keys - @ruslantalpa
+- Ensure that Location header in 201 response is URL-encoded - @league
 
 ## [0.3.1.1] - 2016-03-28
 

src/PostgREST/App.hs

@@ -8,6 +8,7 @@ module PostgREST.App (
 
 import           Control.Applicative
 import           Data.Bifunctor            (first)
+import qualified Data.ByteString.Char8   as BS
 import           Data.IORef                (IORef, readIORef)
 import           Data.List                 (find, delete)
 import           Data.Maybe                (isJust, fromMaybe, fromJust, mapMaybe)
@@ -24,6 +25,7 @@ import           Text.ParserCombinators.Parsec (parse)
 
 import           Network.HTTP.Types.Header
 import           Network.HTTP.Types.Status
+import           Network.HTTP.Types.URI (renderSimpleQuery)
 import           Network.Wai
 import           Network.Wai.Middleware.RequestLogger (logStdout)
 
@@ -128,15 +130,13 @@ app dbStructure conf apiRequest =
           let pKeys = map pkName $ filter (filterPk schema table) allPrKeys -- would it be ok to move primary key detection in the query itself?
           let stm = createWriteStatement qi sq mq isSingle (iPreferRepresentation apiRequest) pKeys (contentType == TextCSV) payload
           row <- H.query uniform stm
-          let (_, _, location, body) = extractQueryResult row
+          let (_, _, locationFieldsOpt, body) = extractQueryResult row
+              mkHeader fs = [(hLocation, "/" <> cs table <> renderLocationFields fs)]
+              header = maybe [] mkHeader locationFieldsOpt
 
           return $ if iPreferRepresentation apiRequest == Full
-            then responseLBS status201 [
+            then responseLBS status201 (contentTypeH : header) (cs body)
-                  contentTypeH,
+            else responseLBS status201 header ""
-                  (hLocation, "/" <> cs table <> "?" <> cs location)
-                ] (cs body)
-            else responseLBS status201
-              [(hLocation, "/" <> cs table <> "?" <> cs location)] ""
 
     (ActionUpdate, TargetIdent qi, Just payload@(PayloadJSON uniform)) ->
       case mutateSqlParts of
@@ -235,6 +235,14 @@ app dbStructure conf apiRequest =
                                           status = rangeStatus frm to (toInteger <$> tableTotal)
                                       in (status, contentRange)
 
+splitKeyValue :: BS.ByteString -> (BS.ByteString, BS.ByteString)
+splitKeyValue kv = (k, BS.tail v)
+  where (k, v) = BS.break (== '=') kv
+
+renderLocationFields :: [BS.ByteString] -> BS.ByteString
+renderLocationFields fields =
+  renderSimpleQuery True $ map splitKeyValue fields
+
 rangeStatus :: Integer -> Integer -> Maybe Integer -> Status
 rangeStatus _ _ Nothing = status200
 rangeStatus frm to (Just total)
@@ -371,4 +379,4 @@ instance ToJSON TableOptions where
 
 
 extractQueryResult :: Maybe ResultsWithCount -> ResultsWithCount
-extractQueryResult = fromMaybe (Nothing, 0, "", "")
+extractQueryResult = fromMaybe (Nothing, 0, Nothing, "")

src/PostgREST/QueryBuilder.hs

@@ -46,7 +46,7 @@ import qualified Data.Text as T          (map, takeWhile)
 import qualified Data.Text.Encoding as T
 import           Data.String.Conversions (cs)
 import           Control.Applicative     ((<|>))
--- import           Control.Monad           (join)
+import           Control.Monad           (replicateM)
 import           Data.Tree               (Tree(..))
 import qualified Data.Vector as V
 import           PostgREST.Types
@@ -61,9 +61,22 @@ import           Data.Scientific         ( FPFormat (..)
 import           Prelude hiding          (unwords)
 import           PostgREST.ApiRequest    (PreferRepresentation (..))
 
+{-| The generic query result format used by API responses. The location header
+    is represented as a list of strings containing variable bindings like
+    @"k1=eq.42"@. If unused, it's null/Nothing rather than the empty list
+    because 'PostgreSQL.Binary.Decoder.arrayDimension' cannot decode an empty
+    array!
+-}
+type ResultsWithCount = (Maybe Int64, Int64, Maybe [BS.ByteString], BS.ByteString)
 
-{-| The generic query result format used by API responses -}
+standardRow :: HD.Row ResultsWithCount
-type ResultsWithCount = (Maybe Int64, Int64, BS.ByteString, BS.ByteString)
+standardRow = (,,,) <$> HD.nullableValue HD.int8 <*> HD.value HD.int8
+                    <*> HD.nullableValue header <*> HD.value HD.bytea
+  where
+    header = HD.array $ HD.arrayDimension replicateM $ HD.arrayValue HD.bytea
+
+noLocationF :: Text
+noLocationF = "NULL::text[]"
 
 {-| Read and Write api requests use a similar response format which includes
     various record counts and possible location header. This is the decoder
@@ -72,16 +85,10 @@ type ResultsWithCount = (Maybe Int64, Int64, BS.ByteString, BS.ByteString)
 decodeStandard :: HD.Result ResultsWithCount
 decodeStandard =
   HD.singleRow standardRow
- where
-  standardRow = (,,,) <$> HD.nullableValue HD.int8 <*> HD.value HD.int8
-                      <*> HD.value HD.bytea <*> HD.value HD.bytea
 
 decodeStandardMay :: HD.Result (Maybe ResultsWithCount)
 decodeStandardMay =
   HD.maybeRow standardRow
- where
-  standardRow = (,,,) <$> HD.nullableValue HD.int8 <*> HD.value HD.int8
-                      <*> HD.value HD.bytea <*> HD.value HD.bytea
 
 {-| JSON and CSV payloads from the client are given to us as
     UniformObjects (objects who all have the same keys),
@@ -103,7 +110,7 @@ createReadStatement selectQuery countQuery range isSingle countTotal asCsv =
   cols = intercalate ", " [
       countResultF <> " AS total_result_set",
       "pg_catalog.count(t) AS page_total",
-      "'' AS header",
+      noLocationF <> " AS header",
       bodyF <> " AS body"
     ]
   bodyF
@@ -121,7 +128,7 @@ createWriteStatement _ _ mutateQuery _ None
  where
   sql = [qc|
       WITH {sourceCTEName} AS ({mutateQuery})
-      SELECT '', 0, '', '' |]
+      SELECT '', 0, {noLocationF}, '' |]
 
 createWriteStatement qi _ mutateQuery isSingle HeadersOnly
                      pKeys _ (PayloadJSON (UniformObjects _)) =
@@ -134,7 +141,7 @@ createWriteStatement qi _ mutateQuery isSingle HeadersOnly
   cols = intercalate ", " [
       "'' AS total_result_set",
       "pg_catalog.count(t) AS page_total",
-      if isSingle then locationF pKeys else "''",
+      if isSingle then locationF pKeys else noLocationF,
       "''"
     ]
 
@@ -149,7 +156,7 @@ createWriteStatement qi selectQuery mutateQuery isSingle Full
   cols = intercalate ", " [
       "'' AS total_result_set", -- when updateing it does not make sense
       "pg_catalog.count(t) AS page_total",
-      if isSingle then locationF pKeys else "''" <> " AS header",
+      if isSingle then locationF pKeys else noLocationF <> " AS header",
       bodyF <> " AS body"
     ]
   bodyF
@@ -394,7 +401,7 @@ locationF :: [Text] -> SqlFragment
 locationF pKeys =
     "(" <>
     " WITH s AS (SELECT row_to_json(ss) as r from " <> sourceCTEName <> " as ss  limit 1)" <>
-    " SELECT string_agg(json_data.key || '=' || coalesce( 'eq.' || json_data.value, 'is.null'), '&')" <>
+    " SELECT array_agg(json_data.key || '=' || coalesce('eq.' || json_data.value, 'is.null'))" <>
     " FROM s, json_each_text(s.r) AS json_data" <>
     (
       if null pKeys

test/Feature/InsertSpec.hs

@@ -121,13 +121,22 @@ spec = do
             simpleStatus p `shouldBe` created201
 
     context "with compound pk supplied" $
-      it "builds response location header appropriately" $
+      it "builds response location header appropriately" $ do
-        post "/compound_pk" [json| { "k1":12, "k2":42 } |]
+        let inserted    = [json| { "k1":12, "k2":"Rock & R+ll" } |]
-          `shouldRespondWith` ResponseMatcher {
+            expectedObj = CompoundPK 12 "Rock & R+ll" Nothing
-            matchBody    = Nothing,
+            expectedLoc = "/compound_pk?k1=eq.12&k2=eq.Rock%20%26%20R%2Bll"
-            matchStatus  = 201,
+        p <- request methodPost "/compound_pk"
-            matchHeaders = ["Location" <:> "/compound_pk?k1=eq.12&k2=eq.42"]
+                     [("Prefer", "return=representation")]
-          }
+                     inserted
+        liftIO $ do
+          JSON.decode (simpleBody p) `shouldBe` Just expectedObj
+          simpleStatus p `shouldBe` created201
+          lookup hLocation (simpleHeaders p) `shouldBe` Just expectedLoc
+
+        r <- get expectedLoc
+        liftIO $ do
+          JSON.decode (simpleBody r) `shouldBe` Just [expectedObj]
+          simpleStatus r `shouldBe` ok200
 
     context "with invalid json payload" $
       it "fails with 400 and error" $
@@ -148,24 +157,26 @@ spec = do
     context "jsonb" $ do
       it "serializes nested object" $ do
         let inserted = [json| { "data": { "foo":"bar" } } |]
+            location = "/json?data=eq.%7B%22foo%22%3A%22bar%22%7D"
         request methodPost "/json"
                      [("Prefer", "return=representation")]
                      inserted
           `shouldRespondWith` ResponseMatcher {
             matchBody    = Just inserted
           , matchStatus  = 201
-          , matchHeaders = ["Location" <:> [str|/json?data=eq.{"foo":"bar"}|]]
+          , matchHeaders = ["Location" <:> location]
           }
 
       it "serializes nested array" $ do
         let inserted = [json| { "data": [1,2,3] } |]
+            location = "/json?data=eq.%5B1%2C2%2C3%5D"
         request methodPost "/json"
                      [("Prefer", "return=representation")]
                      inserted
           `shouldRespondWith` ResponseMatcher {
             matchBody    = Just inserted
           , matchStatus  = 201
-          , matchHeaders = ["Location" <:> [str|/json?data=eq.[1,2,3]|]]
+          , matchHeaders = ["Location" <:> location]
           }
 
   describe "CSV insert" $ do
@@ -270,7 +281,7 @@ spec = do
               length rows `shouldBe` 1
               let record = head rows
               compoundK1 record `shouldBe` 12
-              compoundK2 record `shouldBe` 42
+              compoundK2 record `shouldBe` "42"
               compoundExtra record `shouldBe` Just 3
 
           it "can update an existing record" $ do

test/TestTypes.hs

@@ -37,9 +37,9 @@ instance JSON.FromJSON IncPK where
 
 data CompoundPK = CompoundPK {
   compoundK1 :: Int
-, compoundK2 :: Int
+, compoundK2 :: String
 , compoundExtra :: Maybe Int
-}
+} deriving (Eq, Show)
 
 instance JSON.FromJSON CompoundPK where
   parseJSON (JSON.Object r) = CompoundPK <$>

test/fixtures/schema.sql

@@ -443,7 +443,7 @@ CREATE TABLE complex_items (
 
 CREATE TABLE compound_pk (
     k1 integer NOT NULL,
-    k2 integer NOT NULL,
+    k2 text NOT NULL,
     extra integer
 );