git.iko.soy/servant
on master help sign in
Merge pull request #84 from haskell-servant/wip-json-decode-eof

fix a bug in our `eitherDecodeLenient` function

commit5c25c56d5077b23b2cfc7eda8b0f60cb2f9c8247 authorAlp Mestanogullari <alpmestan@gmail.com> dateSat 23 May 2015, 12:56 (11 years ago) parent763928c5413182
2 files changed+55−38
compare with master
unifiedsplit
servant/src/Servant/API/ContentTypes.hs+36−22 servant/test/Servant/API/ContentTypesSpec.hs+19−16
servant/src/Servant/API/ContentTypes.hs+36−22
@@ -66,29 +66,31 @@ module Servant.API.ContentTypes
6666 ) where
6767
6868#if !MIN_VERSION_base(4,8,0)
69−import Control.Applicative ((<*))
69+import Control.Applicative ((*>), (<*))
7070#endif
71−import Control.Arrow (left)
71+import Control.Arrow (left)
7272import Control.Monad
73−import Data.Aeson (FromJSON, ToJSON, Value,
74− encode, parseJSON)
75−import Data.Aeson.Parser (value)
76−import Data.Aeson.Types (parseEither)
77−import Data.Attoparsec.ByteString (endOfInput, parseOnly)
78−import qualified Data.ByteString as BS
79−import Data.ByteString.Lazy (ByteString, fromStrict, toStrict)
80−import qualified Data.ByteString.Lazy as B
73+import Data.Aeson (FromJSON, ToJSON, encode,
74+ parseJSON)
75+import Data.Aeson.Parser (value)
76+import Data.Aeson.Types (parseEither)
77+import Data.Attoparsec.ByteString.Char8 (endOfInput, parseOnly,
78+ skipSpace, (<?>))
79+import qualified Data.ByteString as BS
80+import Data.ByteString.Lazy (ByteString, fromStrict,
81+ toStrict)
82+import qualified Data.ByteString.Lazy as B
8183import Data.Monoid
82−import Data.String.Conversions (cs)
83−import qualified Data.Text as TextS
84−import qualified Data.Text.Encoding as TextS
85−import qualified Data.Text.Lazy as TextL
86−import qualified Data.Text.Lazy.Encoding as TextL
84+import Data.String.Conversions (cs)
85+import qualified Data.Text as TextS
86+import qualified Data.Text.Encoding as TextS
87+import qualified Data.Text.Lazy as TextL
88+import qualified Data.Text.Lazy.Encoding as TextL
8789import Data.Typeable
88−import GHC.Exts (Constraint)
89−import qualified Network.HTTP.Media as M
90−import Network.URI (escapeURIString, isUnreserved,
91− unEscapeString)
90+import GHC.Exts (Constraint)
91+import qualified Network.HTTP.Media as M
92+import Network.URI (escapeURIString,
93+ isUnreserved, unEscapeString)
9294
9395-- * Provided content types
9496data JSON deriving Typeable
@@ -291,10 +293,22 @@ instance MimeRender OctetStream BS.ByteString where
291293
292294-- | Like 'Data.Aeson.eitherDecode' but allows all JSON values instead of just
293295-- objects and arrays.
296+--
297+-- Will handle trailing whitespace, but not trailing junk. ie.
298+--
299+-- >>> eitherDecodeLenient "1 " :: Either String Int
300+-- Right 1
301+--
302+-- >>> eitherDecodeLenient "1 junk" :: Either String Int
303+-- Left "trailing junk after valid JSON: endOfInput"
294304eitherDecodeLenient :: 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
305+eitherDecodeLenient input =
306+ parseOnly parser (cs input) >>= parseEither parseJSON
307+ where
308+ parser = skipSpace
309+ *> Data.Aeson.Parser.value
310+ <* skipSpace
311+ <* (endOfInput <?> "trailing junk after valid JSON")
298312
299313-- | `eitherDecode`
300314instance FromJSON a => MimeUnrender JSON a where
servant/test/Servant/API/ContentTypesSpec.hs+19−16
@@ -8,14 +8,15 @@ module Servant.API.ContentTypesSpec where
88
99#if !MIN_VERSION_base(4,8,0)
1010import Control.Applicative
11+import Data.Monoid
1112#endif
1213import Control.Arrow
1314import Data.Aeson
1415import Data.Aeson.Parser (jstring)
1516import Data.Attoparsec.ByteString (parseOnly)
17+import Data.Either
1618import Data.Function (on)
1719import Data.Proxy
18−
1920import Data.ByteString.Char8 (ByteString, append, pack)
2021import qualified Data.ByteString.Lazy as BSL
2122import Data.List (maximumBy)
@@ -36,54 +37,56 @@ spec :: Spec
3637spec = describe "Servant.API.ContentTypes" $ do
3738
3839 describe "The JSON Content-Type type" $ do
40+ let p = Proxy :: Proxy JSON
41+
42+ it "handles whitespace at end of input" $ do
43+ mimeUnrender p "[1] " `shouldBe` Right [1 :: Int]
44+
45+ it "handles whitespace at beginning of input" $ do
46+ mimeUnrender p " [1] " `shouldBe` Right [1 :: Int]
47+
48+ it "does not like junk at end of input" $ do
49+ mimeUnrender p "[1] this probably shouldn't work"
50+ `shouldSatisfy` (isLeft :: Either a [Int] -> Bool)
3951
4052 it "has mimeUnrender reverse mimeRender for valid top-level json ([Int]) " $ do
41− let p = Proxy :: Proxy JSON
4253 property $ \x -> mimeUnrender p (mimeRender p x) == Right (x::[Int])
4354
4455 it "has mimeUnrender reverse mimeRender for valid top-level json " $ do
45− let p = Proxy :: Proxy JSON
4656 property $ \x -> mimeUnrender p (mimeRender p x) == Right (x::SomeData)
4757
4858 describe "The FormUrlEncoded Content-Type type" $ do
49−
50− let isNonNull ("", "") = False
51− isNonNull _ = True
59+ let p = Proxy :: Proxy FormUrlEncoded
5260
5361 it "has mimeUnrender reverse mimeRender" $ do
54− let p = Proxy :: Proxy FormUrlEncoded
55− property $ \x -> all isNonNull x
62+ property $ \x -> all (/= mempty) x
5663 ==> mimeUnrender p (mimeRender p x) == Right (x::[(TextS.Text,TextS.Text)])
5764
5865 it "has mimeUnrender reverse exportParams (Network.URL)" $ do
59− let p = Proxy :: Proxy FormUrlEncoded
60− property $ \x -> all isNonNull x
66+ property $ \x -> all (/= mempty) x
6167 ==> (mimeUnrender p . cs . exportParams . map (cs *** cs) $ x) == Right (x::[(TextS.Text,TextS.Text)])
6268
6369 it "has importParams (Network.URL) reverse mimeRender" $ do
64− let p = Proxy :: Proxy FormUrlEncoded
65− property $ \x -> all isNonNull x
70+ property $ \x -> all (/= mempty) x
6671 ==> (fmap (map (cs *** cs)) . importParams . cs . mimeRender p $ x) == Just (x::[(TextS.Text,TextS.Text)])
6772
6873 describe "The PlainText Content-Type type" $ do
74+ let p = Proxy :: Proxy PlainText
6975
7076 it "has mimeUnrender reverse mimeRender (lazy Text)" $ do
71− let p = Proxy :: Proxy PlainText
7277 property $ \x -> mimeUnrender p (mimeRender p x) == Right (x::TextL.Text)
7378
7479 it "has mimeUnrender reverse mimeRender (strict Text)" $ do
75− let p = Proxy :: Proxy PlainText
7680 property $ \x -> mimeUnrender p (mimeRender p x) == Right (x::TextS.Text)
7781
7882 describe "The OctetStream Content-Type type" $ do
83+ let p = Proxy :: Proxy OctetStream
7984
8085 it "is id (Lazy ByteString)" $ do
81− let p = Proxy :: Proxy OctetStream
8286 property $ \x -> mimeRender p x == (x :: BSL.ByteString)
8387 && mimeUnrender p x == Right x
8488
8589 it "is fromStrict/toStrict (Strict ByteString)" $ do
86− let p = Proxy :: Proxy OctetStream
8790 property $ \x -> mimeRender p x == BSL.fromStrict (x :: ByteString)
8891 && mimeUnrender p (BSL.fromStrict x) == Right x
8992