git.iko.soy/typeable/servant
on master help sign in
servant: allow whitespace after parsing JSON

This includes some de-duplication in the test suite.

commit43d06204036123981b24167e6245cb08ae5e2499 authorChristian Marie <christian@ponies.io> dateSat 16 May 2015, 11:11 (11 years ago) parent955261d
2 files changed+35−21
compare with master
unifiedsplit
servant/src/Servant/API/ContentTypes.hs+19−6 servant/test/Servant/API/ContentTypesSpec.hs+16−15
servant/src/Servant/API/ContentTypes.hs+19−6
@@ -70,11 +70,12 @@ import Control.Applicative ((<*))
7070#endif
7171import Control.Arrow (left)
7272import Control.Monad
73−import Data.Aeson (FromJSON, ToJSON, Value,
74− encode, parseJSON)
73+import Data.Aeson (FromJSON, ToJSON, encode,
74+ parseJSON)
7575import Data.Aeson.Parser (value)
7676import Data.Aeson.Types (parseEither)
77−import Data.Attoparsec.ByteString (endOfInput, parseOnly)
77+import Data.Attoparsec.ByteString.Char8 (endOfInput, parseOnly,
78+ skipSpace, (<?>))
7879import qualified Data.ByteString as BS
7980import Data.ByteString.Lazy (ByteString, fromStrict, toStrict)
8081import qualified Data.ByteString.Lazy as B
@@ -291,10 +292,22 @@ instance MimeRender OctetStream BS.ByteString where
291292
292293-- | Like 'Data.Aeson.eitherDecode' but allows all JSON values instead of just
293294-- objects and arrays.
295+--
296+-- Will handle trailing whitespace, but not trailing junk. ie.
297+--
298+-- >>> eitherDecodeLenient "1 " :: Either String Int
299+-- Right 1
300+--
301+-- >>> eitherDecodeLenient "1 junk" :: Either String Int
302+-- Left "trailing junk after valid JSON: endOfInput"
294303eitherDecodeLenient :: FromJSON a => ByteString -> Either String a
295−eitherDecodeLenient input = do
296− v :: Value <- parseOnly (Data.Aeson.Parser.value <* endOfInput) (cs input)
297− parseEither parseJSON v
304+eitherDecodeLenient input =
305+ parseOnly parser (cs input) >>= parseEither parseJSON
306+ where
307+ parser =
308+ Data.Aeson.Parser.value
309+ <* skipSpace
310+ <* (endOfInput <?> "trailing junk after valid JSON")
298311
299312-- | `eitherDecode`
300313instance FromJSON a => MimeUnrender JSON a where
servant/test/Servant/API/ContentTypesSpec.hs+16−15
@@ -10,6 +10,7 @@ module Servant.API.ContentTypesSpec where
1010import Control.Applicative
1111#endif
1212import Control.Arrow
13+import Data.Either
1314import Data.Aeson
1415import Data.Aeson.Parser (jstring)
1516import Data.Attoparsec.ByteString (parseOnly)
@@ -25,6 +26,7 @@ import Data.String.Conversions (cs)
2526import qualified Data.Text as TextS
2627import qualified Data.Text.Lazy as TextL
2728import GHC.Generics
29+import Data.Monoid
2830import Network.URL (exportParams, importParams)
2931import Test.Hspec
3032import Test.QuickCheck
@@ -36,54 +38,53 @@ spec :: Spec
3638spec = describe "Servant.API.ContentTypes" $ do
3739
3840 describe "The JSON Content-Type type" $ do
41+ let p = Proxy :: Proxy JSON
42+
43+ it "handles whitespace at end of input" $ do
44+ mimeUnrender p "[1] " `shouldBe` Right [1 :: Int]
45+
46+ it "does not like junk at end of input" $ do
47+ mimeUnrender p "[1] this probably shouldn't work"
48+ `shouldSatisfy` (isLeft :: Either a [Int] -> Bool)
3949
4050 it "has mimeUnrender reverse mimeRender for valid top-level json ([Int]) " $ do
41− let p = Proxy :: Proxy JSON
4251 property $ \x -> mimeUnrender p (mimeRender p x) == Right (x::[Int])
4352
4453 it "has mimeUnrender reverse mimeRender for valid top-level json " $ do
45− let p = Proxy :: Proxy JSON
4654 property $ \x -> mimeUnrender p (mimeRender p x) == Right (x::SomeData)
4755
4856 describe "The FormUrlEncoded Content-Type type" $ do
49−
50− let isNonNull ("", "") = False
51− isNonNull _ = True
57+ let p = Proxy :: Proxy FormUrlEncoded
5258
5359 it "has mimeUnrender reverse mimeRender" $ do
54− let p = Proxy :: Proxy FormUrlEncoded
55− property $ \x -> all isNonNull x
60+ property $ \x -> all (/= mempty) x
5661 ==> mimeUnrender p (mimeRender p x) == Right (x::[(TextS.Text,TextS.Text)])
5762
5863 it "has mimeUnrender reverse exportParams (Network.URL)" $ do
59− let p = Proxy :: Proxy FormUrlEncoded
60− property $ \x -> all isNonNull x
64+ property $ \x -> all (/= mempty) x
6165 ==> (mimeUnrender p . cs . exportParams . map (cs *** cs) $ x) == Right (x::[(TextS.Text,TextS.Text)])
6266
6367 it "has importParams (Network.URL) reverse mimeRender" $ do
64− let p = Proxy :: Proxy FormUrlEncoded
65− property $ \x -> all isNonNull x
68+ property $ \x -> all (/= mempty) x
6669 ==> (fmap (map (cs *** cs)) . importParams . cs . mimeRender p $ x) == Just (x::[(TextS.Text,TextS.Text)])
6770
6871 describe "The PlainText Content-Type type" $ do
72+ let p = Proxy :: Proxy PlainText
6973
7074 it "has mimeUnrender reverse mimeRender (lazy Text)" $ do
71− let p = Proxy :: Proxy PlainText
7275 property $ \x -> mimeUnrender p (mimeRender p x) == Right (x::TextL.Text)
7376
7477 it "has mimeUnrender reverse mimeRender (strict Text)" $ do
75− let p = Proxy :: Proxy PlainText
7678 property $ \x -> mimeUnrender p (mimeRender p x) == Right (x::TextS.Text)
7779
7880 describe "The OctetStream Content-Type type" $ do
81+ let p = Proxy :: Proxy OctetStream
7982
8083 it "is id (Lazy ByteString)" $ do
81− let p = Proxy :: Proxy OctetStream
8284 property $ \x -> mimeRender p x == (x :: BSL.ByteString)
8385 && mimeUnrender p x == Right x
8486
8587 it "is fromStrict/toStrict (Strict ByteString)" $ do
86− let p = Proxy :: Proxy OctetStream
8788 property $ \x -> mimeRender p x == BSL.fromStrict (x :: ByteString)
8889 && mimeUnrender p (BSL.fromStrict x) == Right x
8990