eeva/servant
1
0
Fork 0
Code Issues Pull requests Projects Releases Wiki Activity

Merge pull request #84 from haskell-servant/wip-json-decode-eof

Browse source 
fix a bug in our `eitherDecodeLenient` function
This commit is contained in:
Alp Mestanogullari 2015-05-23 12:56:31 +01:00
commit 5c25c56d50
2 changed files with 55 additions and 38 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

58
servant/src/Servant/API/ContentTypes.hs
View file

@ -66,29 +66,31 @@ module Servant.API.ContentTypes
) where ) where
#if !MIN_VERSION_base(4,8,0) #if !MIN_VERSION_base(4,8,0)
import Control.Applicative ((<*)) import Control.Applicative ((*>), (<*))
#endif #endif
import Control.Arrow (left) import Control.Arrow (left)
import Control.Monad import Control.Monad
import Data.Aeson (FromJSON, ToJSON, Value, import Data.Aeson (FromJSON, ToJSON, encode,
encode, parseJSON) parseJSON)
import Data.Aeson.Parser (value) import Data.Aeson.Parser (value)
import Data.Aeson.Types (parseEither) import Data.Aeson.Types (parseEither)
import Data.Attoparsec.ByteString (endOfInput, parseOnly) import Data.Attoparsec.ByteString.Char8 (endOfInput, parseOnly,
import qualified Data.ByteString as BS skipSpace, (<?>))
import Data.ByteString.Lazy (ByteString, fromStrict, toStrict) import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as B import Data.ByteString.Lazy (ByteString, fromStrict,
toStrict)
import qualified Data.ByteString.Lazy as B
import Data.Monoid import Data.Monoid
import Data.String.Conversions (cs) import Data.String.Conversions (cs)
import qualified Data.Text as TextS import qualified Data.Text as TextS
import qualified Data.Text.Encoding as TextS import qualified Data.Text.Encoding as TextS
import qualified Data.Text.Lazy as TextL import qualified Data.Text.Lazy as TextL
import qualified Data.Text.Lazy.Encoding as TextL import qualified Data.Text.Lazy.Encoding as TextL
import Data.Typeable import Data.Typeable
import GHC.Exts (Constraint) import GHC.Exts (Constraint)
import qualified Network.HTTP.Media as M import qualified Network.HTTP.Media as M
import Network.URI (escapeURIString, isUnreserved, import Network.URI (escapeURIString,
unEscapeString) isUnreserved, unEscapeString)
-- * Provided content types -- * Provided content types
data JSON deriving Typeable data JSON deriving Typeable
@ -291,10 +293,22 @@ instance MimeRender OctetStream BS.ByteString where
-- | Like 'Data.Aeson.eitherDecode' but allows all JSON values instead of just -- | Like 'Data.Aeson.eitherDecode' but allows all JSON values instead of just
-- objects and arrays. -- objects and arrays.
--
-- Will handle trailing whitespace, but not trailing junk. ie.
--
-- >>> eitherDecodeLenient "1 " :: Either String Int
-- Right 1
--
-- >>> eitherDecodeLenient "1 junk" :: Either String Int
-- Left "trailing junk after valid JSON: endOfInput"
eitherDecodeLenient :: FromJSON a => ByteString -> Either String a eitherDecodeLenient :: FromJSON a => ByteString -> Either String a
eitherDecodeLenient input = do eitherDecodeLenient input =
v :: Value <- parseOnly (Data.Aeson.Parser.value <* endOfInput) (cs input) parseOnly parser (cs input) >>= parseEither parseJSON
parseEither parseJSON v where
parser = skipSpace
*> Data.Aeson.Parser.value
<* skipSpace
<* (endOfInput <?> "trailing junk after valid JSON")
-- | `eitherDecode` -- | `eitherDecode`
instance FromJSON a => MimeUnrender JSON a where instance FromJSON a => MimeUnrender JSON a where

35
servant/test/Servant/API/ContentTypesSpec.hs
View file

@ -8,14 +8,15 @@ module Servant.API.ContentTypesSpec where
#if !MIN_VERSION_base(4,8,0) #if !MIN_VERSION_base(4,8,0)
import Control.Applicative import Control.Applicative
import Data.Monoid
#endif #endif
import Control.Arrow import Control.Arrow
import Data.Aeson import Data.Aeson
import Data.Aeson.Parser (jstring) import Data.Aeson.Parser (jstring)
import Data.Attoparsec.ByteString (parseOnly) import Data.Attoparsec.ByteString (parseOnly)
import Data.Either
import Data.Function (on) import Data.Function (on)
import Data.Proxy import Data.Proxy
import Data.ByteString.Char8 (ByteString, append, pack) import Data.ByteString.Char8 (ByteString, append, pack)
import qualified Data.ByteString.Lazy as BSL import qualified Data.ByteString.Lazy as BSL
import Data.List (maximumBy) import Data.List (maximumBy)
@ -36,54 +37,56 @@ spec :: Spec
spec = describe "Servant.API.ContentTypes" $ do spec = describe "Servant.API.ContentTypes" $ do
describe "The JSON Content-Type type" $ do describe "The JSON Content-Type type" $ do
let p = Proxy :: Proxy JSON
it "handles whitespace at end of input" $ do
mimeUnrender p "[1] " `shouldBe` Right [1 :: Int]
it "handles whitespace at beginning of input" $ do
mimeUnrender p " [1] " `shouldBe` Right [1 :: Int]
it "does not like junk at end of input" $ do
mimeUnrender p "[1] this probably shouldn't work"
`shouldSatisfy` (isLeft :: Either a [Int] -> Bool)
it "has mimeUnrender reverse mimeRender for valid top-level json ([Int]) " $ do it "has mimeUnrender reverse mimeRender for valid top-level json ([Int]) " $ do
let p = Proxy :: Proxy JSON
property $ \x -> mimeUnrender p (mimeRender p x) == Right (x::[Int]) property $ \x -> mimeUnrender p (mimeRender p x) == Right (x::[Int])
it "has mimeUnrender reverse mimeRender for valid top-level json " $ do it "has mimeUnrender reverse mimeRender for valid top-level json " $ do
let p = Proxy :: Proxy JSON
property $ \x -> mimeUnrender p (mimeRender p x) == Right (x::SomeData) property $ \x -> mimeUnrender p (mimeRender p x) == Right (x::SomeData)
describe "The FormUrlEncoded Content-Type type" $ do describe "The FormUrlEncoded Content-Type type" $ do
let p = Proxy :: Proxy FormUrlEncoded
let isNonNull ("", "") = False
isNonNull _ = True
it "has mimeUnrender reverse mimeRender" $ do it "has mimeUnrender reverse mimeRender" $ do
let p = Proxy :: Proxy FormUrlEncoded property $ \x -> all (/= mempty) x
property $ \x -> all isNonNull x
==> mimeUnrender p (mimeRender p x) == Right (x::[(TextS.Text,TextS.Text)]) ==> mimeUnrender p (mimeRender p x) == Right (x::[(TextS.Text,TextS.Text)])
it "has mimeUnrender reverse exportParams (Network.URL)" $ do it "has mimeUnrender reverse exportParams (Network.URL)" $ do
let p = Proxy :: Proxy FormUrlEncoded property $ \x -> all (/= mempty) x
property $ \x -> all isNonNull x
==> (mimeUnrender p . cs . exportParams . map (cs *** cs) $ x) == Right (x::[(TextS.Text,TextS.Text)]) ==> (mimeUnrender p . cs . exportParams . map (cs *** cs) $ x) == Right (x::[(TextS.Text,TextS.Text)])
it "has importParams (Network.URL) reverse mimeRender" $ do it "has importParams (Network.URL) reverse mimeRender" $ do
let p = Proxy :: Proxy FormUrlEncoded property $ \x -> all (/= mempty) x
property $ \x -> all isNonNull x
==> (fmap (map (cs *** cs)) . importParams . cs . mimeRender p $ x) == Just (x::[(TextS.Text,TextS.Text)]) ==> (fmap (map (cs *** cs)) . importParams . cs . mimeRender p $ x) == Just (x::[(TextS.Text,TextS.Text)])
describe "The PlainText Content-Type type" $ do describe "The PlainText Content-Type type" $ do
let p = Proxy :: Proxy PlainText
it "has mimeUnrender reverse mimeRender (lazy Text)" $ do it "has mimeUnrender reverse mimeRender (lazy Text)" $ do
let p = Proxy :: Proxy PlainText
property $ \x -> mimeUnrender p (mimeRender p x) == Right (x::TextL.Text) property $ \x -> mimeUnrender p (mimeRender p x) == Right (x::TextL.Text)
it "has mimeUnrender reverse mimeRender (strict Text)" $ do it "has mimeUnrender reverse mimeRender (strict Text)" $ do
let p = Proxy :: Proxy PlainText
property $ \x -> mimeUnrender p (mimeRender p x) == Right (x::TextS.Text) property $ \x -> mimeUnrender p (mimeRender p x) == Right (x::TextS.Text)
describe "The OctetStream Content-Type type" $ do describe "The OctetStream Content-Type type" $ do
let p = Proxy :: Proxy OctetStream
it "is id (Lazy ByteString)" $ do it "is id (Lazy ByteString)" $ do
let p = Proxy :: Proxy OctetStream
property $ \x -> mimeRender p x == (x :: BSL.ByteString) property $ \x -> mimeRender p x == (x :: BSL.ByteString)
&& mimeUnrender p x == Right x && mimeUnrender p x == Right x
it "is fromStrict/toStrict (Strict ByteString)" $ do it "is fromStrict/toStrict (Strict ByteString)" $ do
let p = Proxy :: Proxy OctetStream
property $ \x -> mimeRender p x == BSL.fromStrict (x :: ByteString) property $ \x -> mimeRender p x == BSL.fromStrict (x :: ByteString)
&& mimeUnrender p (BSL.fromStrict x) == Right x && mimeUnrender p (BSL.fromStrict x) == Right x