URL-encode Location header (closes #588)

The database returns an array of key-value strings like `"k1=eq.hello
world"`. Haskell URL-encodes the portion after the equal sign and joins
them with `&`.

Includes updates to tests in Feature.InsertSpec: The CompoundPK has been
modified to have one Int and one String. We attempt to add a key with a
String that has spaces and other special characters. This requires that
the returned Location header is properly URL-encoded.
This commit is contained in:
Christopher League
2016-05-20 10:42:55 -04:00
parent 2cb04c1d5c
commit 5c38b4328b
6 changed files with 62 additions and 35 deletions
+1
View File
@@ -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
+16 -8
View File
@@ -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 [
contentTypeH,
(hLocation, "/" <> cs table <> "?" <> cs location)
] (cs body)
else responseLBS status201
[(hLocation, "/" <> cs table <> "?" <> cs location)] ""
then responseLBS status201 (contentTypeH : header) (cs body)
else responseLBS status201 header ""
(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, "")
+21 -14
View File
@@ -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 -}
type ResultsWithCount = (Maybe Int64, Int64, BS.ByteString, BS.ByteString)
standardRow :: HD.Row ResultsWithCount
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
+21 -10
View File
@@ -121,13 +121,22 @@ spec = do
simpleStatus p `shouldBe` created201
context "with compound pk supplied" $
it "builds response location header appropriately" $
post "/compound_pk" [json| { "k1":12, "k2":42 } |]
`shouldRespondWith` ResponseMatcher {
matchBody = Nothing,
matchStatus = 201,
matchHeaders = ["Location" <:> "/compound_pk?k1=eq.12&k2=eq.42"]
}
it "builds response location header appropriately" $ do
let inserted = [json| { "k1":12, "k2":"Rock & R+ll" } |]
expectedObj = CompoundPK 12 "Rock & R+ll" Nothing
expectedLoc = "/compound_pk?k1=eq.12&k2=eq.Rock%20%26%20R%2Bll"
p <- request methodPost "/compound_pk"
[("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
+2 -2
View File
@@ -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 <$>
+1 -1
View File
@@ -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
);