git.iko.soy/servant
on master help sign in
servant: allow whitespace after parsing JSON
43d0620Christian Marie
servant/src/Servant/API/ContentTypes.hs+19−6
compare with master
unifiedsplit
@@ -70,11 +70,12 @@ import Control.Applicative ((<*))
70#endif
70#endif
71import Control.Arrow (left)
71import Control.Arrow (left)
72import Control.Monad
72import Control.Monad
73−import Data.Aeson (FromJSON, ToJSON, Value,
73+import Data.Aeson (FromJSON, ToJSON, encode,
74− encode, parseJSON)
74+ parseJSON)
75import Data.Aeson.Parser (value)
75import Data.Aeson.Parser (value)
76import Data.Aeson.Types (parseEither)
76import Data.Aeson.Types (parseEither)
77−import Data.Attoparsec.ByteString (endOfInput, parseOnly)
77+import Data.Attoparsec.ByteString.Char8 (endOfInput, parseOnly,
78+ skipSpace, (<?>))
78import qualified Data.ByteString as BS
79import qualified Data.ByteString as BS
79import Data.ByteString.Lazy (ByteString, fromStrict, toStrict)
80import Data.ByteString.Lazy (ByteString, fromStrict, toStrict)
80import qualified Data.ByteString.Lazy as B
81import qualified Data.ByteString.Lazy as B
@@ -291,10 +292,22 @@ instance MimeRender OctetStream BS.ByteString where
291
292
292-- | Like 'Data.Aeson.eitherDecode' but allows all JSON values instead of just
293-- | Like 'Data.Aeson.eitherDecode' but allows all JSON values instead of just
293-- objects and arrays.
294-- 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"
294eitherDecodeLenient :: FromJSON a => ByteString -> Either String a
303eitherDecodeLenient :: FromJSON a => ByteString -> Either String a
295−eitherDecodeLenient input = do
304+eitherDecodeLenient input =
305+ parseOnly parser (cs input) >>= parseEither parseJSON
306+ where
307+ parser =
296− v :: Value <- parseOnly (Data.Aeson.Parser.value <* endOfInput) (cs input)
308+ Data.Aeson.Parser.value
297− parseEither parseJSON v
309+ <* skipSpace
310+ <* (endOfInput <?> "trailing junk after valid JSON")
298
311
299-- | `eitherDecode`
312-- | `eitherDecode`
300instance FromJSON a => MimeUnrender JSON a where
313instance FromJSON a => MimeUnrender JSON a where
servant/test/Servant/API/ContentTypesSpec.hs+16−15
@@ -10,6 +10,7 @@ module Servant.API.ContentTypesSpec where
10import Control.Applicative
10import Control.Applicative
11#endif
11#endif
12import Control.Arrow
12import Control.Arrow
13+import Data.Either
13import Data.Aeson
14import Data.Aeson
14import Data.Aeson.Parser (jstring)
15import Data.Aeson.Parser (jstring)
15import Data.Attoparsec.ByteString (parseOnly)
16import Data.Attoparsec.ByteString (parseOnly)
@@ -25,6 +26,7 @@ import Data.String.Conversions (cs)
25import qualified Data.Text as TextS
26import qualified Data.Text as TextS
26import qualified Data.Text.Lazy as TextL
27import qualified Data.Text.Lazy as TextL
27import GHC.Generics
28import GHC.Generics
29+import Data.Monoid
28import Network.URL (exportParams, importParams)
30import Network.URL (exportParams, importParams)
29import Test.Hspec
31import Test.Hspec
30import Test.QuickCheck
32import Test.QuickCheck
@@ -36,54 +38,53 @@ spec :: Spec
36spec = describe "Servant.API.ContentTypes" $ do
38spec = describe "Servant.API.ContentTypes" $ do
37
39
38 describe "The JSON Content-Type type" $ do
40 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)
39
49
40 it "has mimeUnrender reverse mimeRender for valid top-level json ([Int]) " $ do
50 it "has mimeUnrender reverse mimeRender for valid top-level json ([Int]) " $ do
41− let p = Proxy :: Proxy JSON
42 property $ \x -> mimeUnrender p (mimeRender p x) == Right (x::[Int])
51 property $ \x -> mimeUnrender p (mimeRender p x) == Right (x::[Int])
43
52
44 it "has mimeUnrender reverse mimeRender for valid top-level json " $ do
53 it "has mimeUnrender reverse mimeRender for valid top-level json " $ do
45− let p = Proxy :: Proxy JSON
46 property $ \x -> mimeUnrender p (mimeRender p x) == Right (x::SomeData)
54 property $ \x -> mimeUnrender p (mimeRender p x) == Right (x::SomeData)
47
55
48 describe "The FormUrlEncoded Content-Type type" $ do
56 describe "The FormUrlEncoded Content-Type type" $ do
49−
57+ let p = Proxy :: Proxy FormUrlEncoded
50− let isNonNull ("", "") = False
51− isNonNull _ = True
52
58
53 it "has mimeUnrender reverse mimeRender" $ do
59 it "has mimeUnrender reverse mimeRender" $ do
54− let p = Proxy :: Proxy FormUrlEncoded
55− property $ \x -> all isNonNull x
60+ property $ \x -> all (/= mempty) x
56 ==> mimeUnrender p (mimeRender p x) == Right (x::[(TextS.Text,TextS.Text)])
61 ==> mimeUnrender p (mimeRender p x) == Right (x::[(TextS.Text,TextS.Text)])
57
62
58 it "has mimeUnrender reverse exportParams (Network.URL)" $ do
63 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
61 ==> (mimeUnrender p . cs . exportParams . map (cs *** cs) $ x) == Right (x::[(TextS.Text,TextS.Text)])
65 ==> (mimeUnrender p . cs . exportParams . map (cs *** cs) $ x) == Right (x::[(TextS.Text,TextS.Text)])
62
66
63 it "has importParams (Network.URL) reverse mimeRender" $ do
67 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
66 ==> (fmap (map (cs *** cs)) . importParams . cs . mimeRender p $ x) == Just (x::[(TextS.Text,TextS.Text)])
69 ==> (fmap (map (cs *** cs)) . importParams . cs . mimeRender p $ x) == Just (x::[(TextS.Text,TextS.Text)])
67
70
68 describe "The PlainText Content-Type type" $ do
71 describe "The PlainText Content-Type type" $ do
72+ let p = Proxy :: Proxy PlainText
69
73
70 it "has mimeUnrender reverse mimeRender (lazy Text)" $ do
74 it "has mimeUnrender reverse mimeRender (lazy Text)" $ do
71− let p = Proxy :: Proxy PlainText
72 property $ \x -> mimeUnrender p (mimeRender p x) == Right (x::TextL.Text)
75 property $ \x -> mimeUnrender p (mimeRender p x) == Right (x::TextL.Text)
73
76
74 it "has mimeUnrender reverse mimeRender (strict Text)" $ do
77 it "has mimeUnrender reverse mimeRender (strict Text)" $ do
75− let p = Proxy :: Proxy PlainText
76 property $ \x -> mimeUnrender p (mimeRender p x) == Right (x::TextS.Text)
78 property $ \x -> mimeUnrender p (mimeRender p x) == Right (x::TextS.Text)
77
79
78 describe "The OctetStream Content-Type type" $ do
80 describe "The OctetStream Content-Type type" $ do
81+ let p = Proxy :: Proxy OctetStream
79
82
80 it "is id (Lazy ByteString)" $ do
83 it "is id (Lazy ByteString)" $ do
81− let p = Proxy :: Proxy OctetStream
82 property $ \x -> mimeRender p x == (x :: BSL.ByteString)
84 property $ \x -> mimeRender p x == (x :: BSL.ByteString)
83 && mimeUnrender p x == Right x
85 && mimeUnrender p x == Right x
84
86
85 it "is fromStrict/toStrict (Strict ByteString)" $ do
87 it "is fromStrict/toStrict (Strict ByteString)" $ do
86− let p = Proxy :: Proxy OctetStream
87 property $ \x -> mimeRender p x == BSL.fromStrict (x :: ByteString)
88 property $ \x -> mimeRender p x == BSL.fromStrict (x :: ByteString)
88 && mimeUnrender p (BSL.fromStrict x) == Right x
89 && mimeUnrender p (BSL.fromStrict x) == Right x
89
90